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THE QSUGCP PROGRAM 


1. INTRODUCTION 


OSUGOP is a computer program that was developed at the Ohio State 
University. The name OSUGOP is an acronymn for Ohio State University 
Geometric and Orbital Program. The basic purpose of the program is to perform 
adjustments for ground station coordinates from observations made to satellites 
by stations observing from the ground. The observations can be optical or 
ranges, and the adjustments can be performed in either the geometric or the 
orbital mode. This program is based on many smaller programs developed 
in 1966 and 1967 and written in the SCATRAN language for use on the IBM 709‘4 
computer fKrakiwsky, et al. , 1967 and 1968]. Later programs were also written 
for use on the IBM 7094, but they were written in the FORTRAN IV language. 

In the spring of 1969 the geometric adjustment of optical observations and the 
solutions of the normal equations programs were converted to the FORTRAN IV 
language from the original SCATRAN listings. At that time it was anticipated that 
further additions to the program would be necessary, and for this reason the 
programming was done in such a way that additional programs could be added very 
easily. A system of problem codes was established that would direct the computer 
to perform the different adjustments. In the fall of 1969 additional subroutines 
were added to the system to process range observations in the geometric mode. 

From the fall of 1969 to the spring of 1971, the only changes made in OSUGOP 
were improvements in logic and additional constraint options. Then in the spring 
of 1971 subroutines were added to perform an orbital adjustment. An additional 
change was the ability to read optical data in the GEOS format. 

Of the authors listed, C. R. Schwarz was a graduate student from 
September, 1967 to September, 1970, and is currently with the Defense 
Mapping Agency Topographic Center, Washington, D. C.; M. C. Whiting was 
a graduate student from September, 1970 to January, 1972, and currently 
lives in San Francisco, California. 
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2. PURPOSE OF THE PROGRAM 


OSUGOP is an adjustment program that can be used for many different 
tasks. The main purpose is to perform an adjustment for observing station 
coordinates. The program, however, has been developed in such a way that 
certain specific tasks can be performed without resorting to a complete solution. 

In order to control the data flow in the program, a system of "Problem Code 
Definitions" has been established. These codes are numbers punched in columns 
1 through 20 of a data card that is read by the program near the beginning of the data 
deck. After the problem codes have been read the program uses these codes to 
branch to the subroutines needed to perform the required task. These "Problem 
Code Definitions" are given in Table 1. As it can be seen there are seven (7) different 
types of data that can be processed (see PC ODE (1)). However, at the present time 
(September, 1972) only five of these are operational. The documentation included 
in Table 1 makes the table self-explanatory. If it is desired to perform a solution 
(i.e. , PCODE (2) = 1), it is necessary to impose some constraints on the stations 
in the network. Table 2 is a listing of the "Constraint Code Directory. " A complete 
description of each of these constraints is given in Section 4. 

The purpose of this report is to describe how to use the OSUGOP program. 

In this case it is best to start with the arrangement of the card deck for each of the 
five possible types of adjustments designated by PCODE (1). Figures 1 through 5 are 
schematics of the various cases. Notice that in all cases the deck setup is the same 
through the station coordinate packet. Also notice that there are no program cards. 
The program itself is stored on a disk pack and the JCL cards at the beginning of the 
deck are all that is necessary to call the program. 
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Table 2 


CONSTRAINT CODE DIRECTORY 
WEIGHTED CONSTRAINTS 

1 CONSTRAIN THE COORDINATES OE A STATION AT A PRIORI VALUES*! I .E .WE IGHT IT 

2 IMPOSE CHORD DISTANCE CONSTRAINT*. 

3 IMPOSE RELATIVE POSITION CONSTRAINT* 

4 IMPOSE DIRECTION CONSTRAINT* 

5 CONSTRAIN THE GEODETIC LATITUDE .LONG 1TUDE AND HEIGHT OF A STATION.* 

ABSOLUTE CONSTRAINTS 

11 DEFINE THE ORIGIN OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT EQUATIONS 

12 DEFINE THE ORIENTATION OF I HE COORDINATE SYSTEM BY INNER ADJUSTMENT 

13 DEFINE THE SCALE OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT EQUATIONS 

14 COMPLETELY FIX ONE OR MORE COORDINATES OF A STATION * $ 

15 COMPLETELY FIX ONE OR MORE COORDINATES OF RELATIVE POSITION** 

*IF THE COORDINATES. RELATIVE POSITION, DISTANCE, OR DIRECTION, TO BE 
CONS7RA INEO ARE NOT GIVEN, THE CONSTRAINT IS COMPUTED FROM THE 
APPROXIMATE COORDINATES OF THE STATION (S) INVOLVED 

$THE DIAGONAL ELEMENTS OF THE W MATRIX ARE USED AS CODES TO INDICATE 
WHICH COORDINATES ARE TO BE FIXED. A NON-ZERO CODE MEANS TO FIX 
THE COORDINATE. 
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3. INPUT TO THE OSUGOP PROGRAM 


The input is made up of card packets, which are groups of cards con- 
taining a variable number of cards, and signal cards. Each packet is 
terminated by an end signal card, which is blank in columns 1-79 and 
contains "E" in column 80. The one exception is the optical observation 
packet using the GEOS format. Here the "E" must be punched in column 
73 (denoted "special end card" in Figure 2). Depending on the type of run, 
some packets may or may not be necessary. 

3. 1 Card Format for Required Cards 

Title Packet (always required): As many title cards as desired are 
permitted, containing any text in columns 1-79. This text appears verbatum 
on the first page of the output. An end signal card terminates this packet.. 

Problem Codes (always required): These codes appear on a single 
card and control the type of processing to be performed by the program. 

See Table 1 for a description of each code and the column in which it is 
punched. (Do not put an end signal card after this card). 

Datum Card Packet (always required): This contains a list of the 

ellipsoids on which the input and output ellipsoidal coordinates of the stations 
are located. Each datum is described by 2 cards. 

Card !• 


Columns 

Format 

Contents 

1-2 

12 

Identifying number of datum. 

3-15 

F13.2 

Semi-major axis of ellipsoid. 

16-28 

F13.2 

Semi-minor axis of ellipsoid. 

Card 2. 

Columns 

Format 

Contents 


1-32 4A8 32 character alphabetic name of datum. 
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The datum packet is terminated by an end signal card. 

Station Coordinate Card Packet (always required): Each card gives the 

input (or approximate) coordinates of a station. 


Columns 

Format 

Contents 

1-4 

14 

Identifying number of the station. 

5-6 

12 

Identifying number of the ellipsoid to which 
the ellipsoidal coordinates refer. 

7-24 

4A4, A2 

18 character station name. 

25 

A1 

Sign of latitude. 

26-28 

13 

Degrees of latitude. 

29-31 

13 

Minutes of latitude. 

32-39 

F8.4 

Seconds of latitude. 

40-42 

13 

Degrees of longitude (+East), 

43-45 

13 

Minutes of longitude. 

46-53 

F8.4 

Seconds of longitude. 

54-63 

F10.2 

Ellipsoid height (in meters). 

73-79 

F7.2 

Standard deviation to be used for all obser- 
vations from this station (IF PCODE (12) = 1). 


There is one card for each ground station in the network. This packet is 
terminated by an end signal card. 

The identifying number of the datum for the station coordinates must correspond 
to the number defining the datum. For example, if one only has station coordinates on 
the North American Datum, the datum card packet could contain a card with the number 
1 in column tw'o, and the numbers 6378206.4 and 6356583. 8 for the semi-major and 
semi-minor axes. Then on each station coordinate card one would have to put the 
number 1 in column six to show that these coordinates refer to the North American 
Datum. 


0 
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Figure 1. Deck Setup for Optical Program (OSU Format). 
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Figure 2. Deck Setup for Optical Program (GEOS Format). 
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Figure 3. Deck Setup for Range Program in the Geometric Mode. 
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Figure 5. Deck Setup for Range Observations in the Orbital Mode. 




3.2 Card Formats for the Different Options 

There are five different types of input that can be handled by this program. 
The deck setup for each type of observation will be discussed separately. 

3.2.1 Optical Observations. Geometric Mode . 

There are two different card formats for the optical observations. 
However, the adjustment itself is the same for both. The reason for the two 
different formats is that the original optical programs written in SCATRAN 
utilized a card format that was convenient for the programmer and is 
referred to as the OSU format. Whenever the first optical data from the 
GEOS I satellite became available, it was easier to change the observations 
to the OSU format than to modify the program. When the optical program 
was later converted to FORTRAN IV the OSU format was retained. Because 
the GEOS format has been accepted as a standard format, the computer 
program was modified in 1971 to accept either card format. 

As can be seen from Figures 1 and 2, it is necessary to have a test 
distance card in front of the optical observations. This test distance card is 
used to specify a rejection criteria for each observation. The purpose of 
the rejection criteria is to eliminate bad or questionable observations from 
the adjustment automatically without physically removing the observation 
cards from the card deck. The optical program is designed to read all 
the observations that have the same time of observation, and then per- 
form an adjustment for the position of the satellite. The approximate 
station coordinates of the observation stations are held fixed during this 
adjustment. If the approximate coordinates of the observing stations are 
known to a certain degree of accuracy, and if the observations are known 
to a certain accuracy, the accuracy of the adjusted position of the satellite 
can be predicted. 

The need to have a rejection criteria may not be very obvious, but from 
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past experience it has proved to be very useful. A fairly large percentage 
of the optical data received from the Space Science Data Center in Washington 
had large blunders. By setting the rejection criteria at a reasonable 
value, all bad observations were eliminated from the solution. 

The rejection criteria can also be used when the data is reasonably free 
from bad data but some of the approximate station coordinates are not well 
known. Here the rejection criteria can be set fairly high for one or two 
iterations so that all observations are accepted and the questionable station 
coordinates are allowed to adjust. 

In addition to specifying the rejection criteria, there is a place on the 
test distance card to insert a value for the standard deviations of all observa- 
tions that will override the actual standard deviation punched on the observation 
cards. The standard deviations will then be the same for o;cos5 and 6, and 
the covariance term will be zero. The need for this feature in the program 
became apparent when the standard deviations on the observation cards were 
noted to be completely out of line. 

3. 2. 1.1 Arrangement of Optical Observations . 

The only requirement in the arrangement of observation cards is that they 
are grouped by events. An event is all the data that has been observed on a 
satellite at the same instant of time. The time on the data cards should be 
the same, but the computer program will allow for a deviation of 0. 0002 
seconds. There must be at least two (2) observation cards in an event ( i. e. , 
a minumum of two stations must observe the satellite at the same time). 

If there are more than two stations observing at the same instant of 
time the program will perform an adjustment for the satellite position start- 
ing with all observations. If any of these observations are bad the program 
will delete them and perform an adjustment with the remaining observations. 

If after deleting the bad observations there are less than two stations observing, 
the entire event is deleted. 
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The format of the optical observations must agree with the code 
punched on the problem code card. Using the OSU format 
PCODE (1) =1, and using the GEOS format PCODE (1) = 7. The card formats 
peculiar to these optical observations are described below: 

Test Distance Card . 

Columns Format Contents 


1-20 F20. 2 Rejection criteria, in seconds of arc, to 

be applied to each observation during editing. 
21-30 F10. 2 Standard deviation, in seconds of arc, to 

be used for all observations (if PCODE (12) = 2) 

Optical Observations (OSU Format) Card Packet. 

Columns 

Format 

Contents 

1- 3 

13 

Station identification number. 

6-19 

12, 13, F9.4 

Hours, minutes, seconds of observation 
(expressed in UT1). 

20-26 

12, A3, 12 

Day, month, year of observation (Note: 
month can be either three letters such as 
Jan, Feb, etc., or else the 
number 1,2,..., 12). 

27-41 

213, F9.5 

Hours, minutes, seconds of right 
ascension (rv). 

42-55 

A1,I2, 13, F8.4 

Sign, degrees, minutes, seconds of 
declination (6). 

58-62 

F5.2 

Standard deviation of a multiplied by the 
cosine of the declination, in seconds of arc. 

63-67 

F5.2 

Standard deviation of 6 , in seconds of arc. 

68-72 

F5.2 

Covariance between a. cos 6 and 6 , in seconds 
of arc squared. 


This packet is terminated by an end signal card. 
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Optical Observations (GEOS Format) Card Packet 


Columns 

Format 

Contents 

15-18 

14 

Station identification number. 

19-24 

312 

Year, month, day of observation (Note: 
Month must be expressed as a number) 

25-34 

212, F6.4 

Hours, minutes, seconds of observation 
(expressed in UTl). 

35-44 

13, 12, F5.3 

Hours, minutes, seconds of right 
ascension (a). 

45-53 

Al, 212, F4.2 

Sign, degrees, minutes, seconds of 
declination. 

72-74 

F3.2 

Standard deviation of ex multiplied by the 
cosine of the declination, in seconds of 
arc. 

75-77 

F3.2 

Standard deviation of declination 6, in 
seconds of arc. 

78-80 

F3.1 

Covariance between cx cos 6 and 6 , in 
seconds of arc squared. 

This 

card 

packet is' terminated by a special end signal card. This 
has the letter E punched in column 71. 

3.2.2 Range Observations, 

Geometric Mode. 


As with the optical observations, a test card is required in front of the 
range observations. The purpose of the card is the same as described for 
the optical observations. The arrangement of the range observations has the 
same basic requirement as optical observation, and this is the grouping of 
observations by events. The minimum number of observations for an event 
is four (4). This subprogram does not nave the provision for elimination of 
individual observations from an event; if one observation is bad, the entire 
event is deleted. 

When using the range observations in the geometric mode, PCODE(l) = 2. 
The card format for the range observations is the GEOS range format. The 
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GEOS format as given by NASA uses all 80 columns of the data card. Since 
many columns are used for information such as satellite number, year of 
launch, etc., they are not included in the card format description that 
follows. The only information included in this description is data pertinent 
to the observation itself. 

Test Distance Card 


Columns 

Format 

Contents 

1-20 

F20.2 

Rejection criteria, in meters, to be 
applied to each event. 

21-30 

F10.2 

Standard deviation, in meters, to be 
used for all observations (if PCODE 
(12) = 2). 

Range Observation 

Card Packet 


Columns 

Format 

Contents 

15-18 

14 

Station identification number. 

19-24 

312 

Year, month, day of observation. 

25-34 

12, 12, F6.4 

Hours, minutes, seconds of observation. 

44-53 

F10.3 

Range, in meters. 

65-70 

F6.3 

Standard deviation, in meters. 


This packet is terminated by an end signal card. 

The time (hours, minutes, seconds) of observation for range obser- 
vations in the geometric mode can be in any time system. In every other 
type of adjustment the times must be in the UTl time system, but in this 
case, the times are used only to distinguish the different events. 

3.2.3 Solution Using Punched Normal Equations. 

Whenever the OSUGOP Program is used with observations, it is possible 
to punch the normal equations on cards. These normals are punched prior 
to the addition of constraints, which means that the matrix of the normal 
equations is singular. This punching is made possible by setting PCODE 
(9) = 1. 
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The reasons for punching the normal equations are many. The most 
common use is that if many different solutions are to be run using the 
same observations, but with different constraints it is more efficient to 
form the normals only once, and then run the different solutions by changing 
only the constraints. It may take fifteen minutes of computer time to form 
the normal equations, and only fifteen seconds to perform the solution. 

Another important reason for punching normal equations is for use in a 
combination solution of two or more different systems of equations. The. . 
different sets of normal equations can be solved together, using constraint 
or ties between the systems. 

Because of the need for punched normal equations, the punched output 
should be in such a format that the user can easily distinguish which 
rows and columns refer to a particular station. This has been accomplished 
by forming the normal equations in what is referred to as the ASD format. 

This is a collapsed form of normal equations where all zero elements have 
been eliminated. All matrix elements are in the form of 3 x 3 matrices 
(3 unknowns for each station). However, additional information other than just the 
elements of the matrix is punched. It is necessary to include the stations numbers and 
a code number to indicate the end of a row. Also, the degrees of freedom 
(d.o.f. ) and the summation of V'PV are needed. Since these normal 
equations are really a system of equations, the discrepency vector, U, 
must be included. The discrepancy vector is the vector U in the 
expressions 

NX + U = 0 
X - -N _1 u . 

The punched output of normal equations starts by punching the d.o.f. . 
and EV’PV on one card, and then punching each row of the normal equation. 

The first card for each row is the station number. The next card gives 
the three elements of the U vector that corresponds to this station number. 
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The next three cards are the elements of the 3x3 matrix that correspond 
to this station. Following this are the off-diagonal elements, which in this 
case are the 3x3 matrices corresponding to all the other stations that co- 
observed with the first station of this row. These are denoted by punching 
a card with the station number, and then three cards with the 3x3 matrix. 
This is repeated for all stations that co-observed. After the last set of 
elements for the row have been punched, a card containing the number 999 
is punched to indicate the end of the row. After that the next row is 
punched, and so on until the end of the matrix has been reached. 

A sample of the punched output can be seen in Figure 6. The first 
line shows the d.o.f. (4069) and SV'PV (6737. 147170) . The next printed 
line indicates that the first row of normal equations has station number 9066 
on the diagonal. The following card gives the three elements of the U 
vector, and the three cards following this are the elements of the 3x3 
matrix corresponding to station 9066. After the diagonal elements come 
the stations that co-observed with station 9066, and the 3X3 matrix of 
off-diagonal elements for each of these stations. In this case, they are 
stations 8015 and 8019. The end of the first row is marked by the 999 
(15th line). 

Whenever the computer is asked to punch a set of normal equations, 
it is always a good idea to set the proper P CODES to print the normals 
also, as well as a guide matrix to indicate the layout of the matrix. 

This can be done with PCODE (6) and PCODE (7) (see Table 1). The 
guide matrix that corresponds to the normal equations in Figure 6 is 
given below: 
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9066 

0 .4663326 33 0 
0.0^41344859 
0.0066? 5 7 696 
-0.00 2 169 5?. 5 3 
0 01? 

-0.0077663337 
-0 . 0023966059 
-0.00266 9 2 9 8 7 
8019 

- 0.01 666 7? 851 
0.0076629836 
-0.0018020912 
999 
8013 

-1.261261 113? 
0.1672091620 
0.005063683? 
- 0 . .062 876 96 31 
80 1.9 

-0, 11 98067022 
0.0063907000 
0.0627791638 
.9051 

-0.0106327398 
0.0011620229 
0. 0030666112 

999 

9080 

-0.6712158212 
0.01 6213 07 88 
0.000995534? 
-0.01 22346437 
999 


6069.000000 6737 . 147170 


-0.7695279730 -0.4691234316 

0 . n 0 64 5 5 7 6 96 -0.00 2 1695353 


0.1576 3 8 2 8 3 3 
-0.0109005340 


-0.0109005340 

0.0317712433 


-0 „ 0022595720 
— 0.03146 0 0 6 6 6 
0 . 0092509). 0 8 


-0. 0029675092 
0. 00 9 6666 83 1 
-0.0125750867 


0.0072840522 

-0.077919955? 

-0.0010346222 


-0. 004 2015838 
-0.0006815355 
-0.005 8 8537 7 6 


0 . 1. 7 5 3 6 < > 0 3 H S 
0 . 0050456835 
0. 104 14642 6). 

-0 « 0037 63525 fv 


0.4569007003 
-0.0428769431 
-0. 0037635258 
0.1294911894 . 


0.0847556960 

-0.0467891914 

-0.0057905394 

0.0011620229 
-0.000189216.°. 
-0. 0005283645 


0.04 2 1 8 0 8712 
-0.0123380813 
-0. 1 05 86 P. 35 2 4 

0.0030444.112 

-0.0005283645 

-0.0014868776 


0.0760527941 0.2145824528 

0 . 0 0 0 9955345 - 0.0 ]. 22 3 4 6 4 3 7 

0.0046783024 -0.0012469197 

-0.0612469197 0.0242084646 


Figure 6. 
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GUIDE MATRIX 


9066 

8015 

8019 

999 

8015 

8019 

9051 

999 

9080 

999 




Although it cannot be easily seen from the above guide matrix, the matrix 
of normal equations is upper-triangular. Another example of a guide matrix 
is shown in Figure 16. 

When using punched normal equations to perform an adjustment, the 
deck setup is as shown in Figure 4. After the constraint packet, the card 
containing d. o.f. and ZV'PV is first, then the normal equations, and at the end 
the additional 999 card or an end-signal card with the letter E punched in 
Column 80. PCODE(l) is set equal to 3 in this case. 

3.2.3. 1 Combining Different Systems of Normal Equations. 

If different systems of normal equations are to be combined for a single 
adjustment, the only additional work required is to physically combine the 
normal equations together into one data deck. When doing this, there are 
several things that must be done : 

1. There can only be one card with degrees of freedom and 
SV'PV. Therefore, the values for each set of normal 
equations should be added together and the total d. o. f. and 
SV'PV punched on one card. 

2. There can only be one row for any one observing station. 

If station 9000 is included in more than one set of normal 
equations, the 3x3 matrices of diagonal elements corres- 
ponding to this station in each set of normal equations 
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must be added together to form one 3x3 diagonal matrix. 
The same goes for off-diagonal elements. If station 9000 
co-observed with station 9010 in more than one set of 
normal equations, these 3x3 matrices must be added 
together to form one matrix. 

3. Along the same line of reasoning mentioned in 2. , if 

station 9000 is included in more than one set of normals, 
but in the later set co-observed with a station that was not 
included in the first set, the off-diagonal matrix corres- 
ponding to that station in the later set of normals must be 
moved into the row of the first set of normal equations. 
This can best be illustrated by guide matrices for two 
different systems: 


First Set of Normal Equations 


1 

2 

3 

4 999 

2 

3 

4 

999 

3 

4 

999 


4 

999 




Second 

Set of Normal Equations 

4 

5 

6 

999 

5 

6 

999 


6 

999 




Combined Set 

of Normal Equations 

1 

2 

3 

4 999 

2 

3 

4 

999 

3 

4 

999 

• 

4 

5 

6 

999 

5 

6 

999 


6 

999 
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4. Make sure that the matrix of normal equations is upper- 
triangular. As can be seen from the guide matrix of 
combined normals above, Station 1 co-observed with 
Station 2, but when one forms the second row, the 2-1 
station combination is not repeated. 

3.2.4 Range Observations, Orbital Mode. 

In order to use range observations in the orbital mode, the deck set- 
up requires a great deal of work. It is necessary to have three data cards 
at the beginning of the data packet that give the earth constants, coordinates 
of the center of mass, and the uncertainties in the center of mass (see 
Figure 5). After this, the observations are separated into passes, and 
with each pass must be included the approximate orbital elements at a 
particular epoch and a code to tell the program what the coordinate system 
is. The epoch time is also included. Each pass is then separated by an 
end signal card. Because of the complexity of the deck setup, each step 
will be described in detail. 

3. 2. 4.1 Earth Constants. 

The earth constants are the semi-major axis of the earth, GM 
(or kM), gravitational constant x mass, and the rate of rotation of 
the earth. Also included on the earth constants card is the standard 
deviation of the observations if one wants to override the actual standard 
deviation punched on the observation cards. The card format is as 
follows: 


Columns 

Format 

Contents 

1-20 

D20.8 

Semi-major axis of the earth, in 
meters. 

21-40 

D20.8 

GM, in units of cm 3 /see 2 . 

41-60 

D20.8 

Rotation rate of the earth, in 
radians/sec. 

61-80 

D20.8 

Standard deviation, in meters, to 
be used for all observations (if 
P CODE (12) - 2). 
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3. 2. 4. 2 Coordinates of the Center of Mass. 

The coordinates of the center of mass give the location of the center of 
mass with respect to the origin of the ellipsoid used in the adjustment. 

The coordinates of the center of mass are given in the coordinate system 
in which the station coordinates are given. 



Columns 

Format 

Card 1 

1-15 

D15.8 


16-30 

D15.8 


31-45 

D15.8 

Card 2 

1-15 

D15.8 


16-30 

D15.8 


31-45 

D15.8 

3. 2. 4.3 

Orbital Data. 



When inputing orbital data, the 


Contents 

X coordinate of the center of mass. 
Y coordinates of the center of mass. 
Z coordinate of the center of mass. 

uncertainty of the X coordinate of 
the center of mass, in meters. 

uncertainty of the Y coordinate of 
the center of mass, in meters. 

uncertainty in the Z coordinate of 
the center of mass, in meters. 

is separated so that each orbit. 


or pass, is input separately. The first card of each pass gives the pass 
number, name and a code to indicate the type of preliminary orbital elements 
used to describe the orbit (see details below). The next two cards contain 


the orbital elements. The fourth card contains the time of epoch. After the 


time card, the observations for the particular pass are read. The cards do 
not have to be in any order, but to conserve computer time it is best to arrange 
the observations in the order of increasing time. The last card for the pass is 
an end signal card. 


Each pass is arranged the same way as described above and placed one 
behind the other. There is no required order for arranging the different 
passes; the program works on each pass separately. After all passes 
are inserted in the deck, an extra end signal is placed after the last pass. 
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(Note: This end signal card is in addition to the one at the end of the last 
pass of data. ) 

The first card of the pass can have any number or name; these are used 
for identification purposes only. The code (IOCODE) used to indicate the 
type of preliminary orbital elements must be one of the numbers 0 through 
4. 

IOCODE = 0 - means rectangular elements are given in the True Sidereal 
System. 

IOCODE = 1 - means rectangular elements are given in the Modified Sidereal 
System. 

IOCODE = 2 - means the rectangular elements are given in the Earth- Fixed 
System. 

IOCODE = 3 - means Keplerian elements are given, referred to the true 
equator. 

IOCODE = 4 - means Keplerian elements are given, referred to the true 

equator and the 1950.0 equinox (i.e., the SAO Orbital System). 

If the value of IOCODE is 0, 1 or 2, the orbital elements are expressed as 
X,Y,Z on one card, and X,Y,Z on a second card. If IOCODE is 3 or 4 () 
the orbital elements are expressed as the semi-major axis, eccentricity 
and inclination on the first card, and right ascension of the ascending node, 
argument of perigee, and mean anomaly on the second card. 

The fourth card of each pass is the same regardless of the type of 
orbital elements used. This gives the epoch time, which is the time that 
corresponds to the orbital elements. This particular card, at first glance, 
appears to be very confusing due to the fact that there are several options 
for specifying epoch time. Figure 7 is a sample of the fourth card layout. 

If the value of Z CODE is left blank, it means that the orbital elements refer 


(^EPQCHIMJD) IDAY MONTH IYR IH MIN ESEC ZCODE (IHK) IMIN SEC 


Figure 7. 
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to the epoch time given at the left side of the card, and can either be expressed 
in MJD or day, month, year, hour, minutes, seconds. ; If the value of ZCODE 
is anything other than a blank, it means that the epoch time is the hours, minutes 
and seconds given on the right-hand side of the card. The distinction between 
these two times is that if the epoch time is given on the right-hand side of the 
card, the epoch time is outside the timespan of the pass, and the desired 
epoch time is the time given on the left side of the card. It means 
that the actual epoch time is that given to the right of ZCODE, which may be 
as much as 24 hours away from the time of the pass. In this case, the 
computer program updates the elements to the time given on the left side of the 
cards. Care must be taken to insure that the proper day is given, since only 
hours, minutes and seconds are given on the right-hand side of the card. 

After the time card, the range observations for that particular pass are 
inserted with an end card placed after the last range card. 

The card formats are as follows: 

Orbital Data for Each Pass 



Columns 

Format 

Contents 

Card 1 

1-4 

A4 

Orbit number (can be anything, used 
for analysts identification only). 


5-52 

* 

6A8 

Orbit name (for identification only, 
this can be left blank, if desired). 


53 

11 

IOCODE. This is the number 0, 1, 
2,3 or 4 depending on the coordinate 
system of the orbital elements. 


(i) Orbital elements given in rectangular coordinates 
(IOCODE = 0, 1 or 2). 

Card 2 1-15 D15.8 X coordinate of satellite, in meters. 

16-30 D15.8 Y coordinate of satellite, in meters. 

31-45 D15.8 Z coordinate of satellite, in meters. 


- 25 - 





Columns 

Format 

Contents 

Card 

3 

1-15 

D15.8 

• 

X, the velocity component in the X 
direction, in meters/sec. 



16-30 

D15.8 

Y, the velocity component in the Y 
direction, in meters/sec. 



31-45 

D15.8 

Z, the velocity component in the Z 
direction, in meters/sec. 


(ii) 

Orbital elements given 

as Keplerian elements 



(IOCODE - 

3 or 4). 




Columns 

Format 

Contents 

Card 

2 

1-15 

D15.8 

Semi-major axis of orbital ellipse, 
in meters. 



16-30 

D15.8 

Eccentieity of orbital ellipse. 



31-45 

D15.8 

Inclination of ellipse to equatorial 
plane, in degrees and decimal degrees. 

Card 

3 

1-15 

D15.8 

Right ascension of the ascending node, 
in degrees and decimal degrees. 



16-30 

D15.8 

Argument of perigee, in degrees and 
decimal degrees. 



31-45 

D15.8 

Mean anomaly, in degrees and 
decimal degrees . 




Epoch Time Card 



Columns 

Format 

Contents 

Card 

4 

1-15 

D15.8 

Epoch time expressed in modified 
Julian days (MJD). 



16-20 

15 

Day of the month. 



23-25 

A3 

Month of the year. This can be 
the numbers 1 through 12 or the 
first three letters of the month's 
name, such as JAN, FEB., etc. 



26-30 

15 

Year (last two digits). 



31-35 

15 

Hours . 



36-40 

15 

Minutes . 



41-50 

D10. 5 

Seconds. 
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If the orbital elements given are at a time not in the actual pass itself, 
this time is punched as follows: 

Columns Format Contents 


51-55 

15 

Hours 

56-60 

15 

Minutes 

61-70 

DIO. 5 

Seconds 


(Note: In order for the computer to use this time, something other than 

blanks must be in columns 54 or 55. Therefore, even if the time is zero 
hours, the zeros must be punched in columns 55 or 54 and 55). 

It should be noted that on the format of card No. 4, there is ho ZCODE 
as such described. The FORTRAN coding has been done in such a way that 
columns 54 and 55 are recognized as ZCODE and also as part of the hour 
value. 

Observations Cards. 

The format for the observation card for the orbital adjustment is identical 
to the observation card format described in the Range Observations, Geometric 
mode section of this report (3.2.2). 

The end of data on each pass is marked by placing an end signal card 
after the last observation. 
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4. CONSTRAINTS 


Table 2 is the directory of the constraint codes needed to apply constraints 
to normal equations prior to a solution. There are ten different types of 
constraints that can be applied, five types of weighted constraints and five 
types of absolute constraints. In all cases, the first card gives the constraint 
code, and then depending on the type of constraint, the cards following give 
the required information necessary to apply the constraint. 

4.1 Weighted Constraints. 

4.1.1 Constrain the Coordinate of a Station at its a Priori Value. 

This constraint is used to weight any one or all three Cartesian coordi- 
nates of a station. It is used primarily to control the translation or to 
define the origin of a network of stations. The weight needed to apply this 
constraint is 



where 

ct 0 3 is the a priori unit variance (which, in most cases, is assumed 
to be 1). 

cr j 3 is the variance of the component of the station coordinate, in 
meters squared. 

Four cards are needed to apply this constraint. The first card is the 
constraint code, which in this case is 1. The second card is the number 
of the station to be constrained. On the third card are listed the coordinates 
to be constrained, and the fourth card gives the weights to be applied to 
each of the coordinates. 

If the coordinates to be constrained are the approximate coordinates 
given at the beginning of the program, the third card is replaced by a 
blank. 
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The card formats are as follows: 




Columns 

Format 

Contents 

Card 

1 

1- 2 

12 

Constraint code, which in this case 
is the number 1. 

Card 

2 

1- 5 

15 

Station number of the station to be 
constrained. 

Card 

3 

1-16 

D16.8 

The X component of the station 
coordinate, in meters. 



17-32 

D16.8 

The Y component of the station 
coordinate, in meters. 



33-48 

D16.8 

The Z component of the station 


coordinate, in meters. 

Any one, or all three of the coordi- 
nates can be constrained. If only one 
or two components are to be constrained, 
let the field blank for the part not to 
be constrained. If the approximate 
coordinates as given at the beginning of 
the program are to be constrained, 
card 3 should be blank. 


Card 4 

1-16 

D16.8 

Weight 

to be applied to the X component. 


17-32 

D16.8 

Weight 

to be applied to the 

Y 

component. 


33-48 

D16.8 

Weight 

to be applied to the 

Z 

component. 


4.1.2 Chord Distance Constraint. 

The chord distance constraint is used primarily to apply a scale. The 
chord distance is computed by the program if the approximate station 
coordinates are to be used to compute the chord. If the chord distance 
is known from another source, the distance is punched onto a card. 

Three cards are needed to apply this constraint. The first card is 
the constraint code, which is 2. The second card gives the station numbers 
of the two stations involved in the chord constraint. The third and last 
card gives the chord distance, and the accuracy of the distance. If the 


- 29 - 



accuracy of the chord distance is ] 
on the card is 500,000. The card 



Columns 

Format 

Card 1 

1- 2 

12 

Card 2 

1- 5 

15 


6-10 

15 

Card 3 

1-16 

D16.8 


17-32 

D16.8 


. part in 500,000, the number punched 
formats are as follows: 

Contents 

Constraint code, which is 2. 

Station number of the first station. 
Station number of the second station. 

Chord distance (in meters). This is 
left blank if the chord distance is to 
be computed from the approximate 
coordinates. 

Accuracy of chord distance, expressed 
as the denominator of the accuracy 
ratio. 


4. 1.3 Relative Position Constraint. 

This constraint is used when two or more stations have known positions 
with respect to each other. After the adjustment, the relative positions of 
these stations should remain unchanged, or the change should be within 
the limit of accuracy of the survey that tied the stations together. A 
common use for this constraint is where two or more stations are observing 
from the same small island where the positions of the stations are known 
on a local datum survey but the positions on the datum of the adjustment 
are not known. 

The relative position constraint can only be applied between two stations 
at a time. If there are more than two stations involved, additional relative 
positions constraints must be used. As an example, if the relative positions between 
stations 1, 2 and 3 are to be constrained, a constraint can be applied between stations 
1 and 2, and an additional constraint between stations 2 and 3. A third constraint 
can be applied between stations 1 and 3, but it isn't necessary. 

Four cards are needed to apply this constraint. The first card is 
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the constraint code, which is 3. The second card gives the station numbers 
of the two stations involved in the relative position constraint. The third 
card gives the AX, AY, AZ coordinate difference between the two stations 
that is to be constrained during the adjustment. The fourth and last card 
gives the weights of the coordinate differences. A word of caution is 
necessary about the sign convention. The signs of the coordinate differences 
on card three must correspond to the order the station numbers appear on 
card two. As an example, if on card two the station numbers are 1 and 2, 
with 1 being punched in the first field, the sign convention for card three 
must be X^Xg.Yi- Y s , and Z x - Z 2 . 

The card formats are as follows: 



Columns 

Format 

Contents 

Card 1 

1-2 

12 

Constraint code, which is 3. 

Card 2 

1-5 

15 

Station number of first station (1). 


6-10 

15 

Station number of second station (2). 

Card 3 

1-16 

D16.8 

Coordinate difference AX, expressed 
as X i — X g . 


17-32 

D16.8 

Coordinate difference Ay, expressed 
as Y x -Y, . 


33-48 

D16.8 

Coordinate difference AZ, expressed 
as Z t - Z s . 

Card 4 

1-16 

D16.8 

Weight to be applied to the AX 
coordinate difference. 


17-32 

D16.8 

Weight to be applied to the AY 
coordinate difference. 


33-48 

D16.8 

Weight to be applied to the AZ 
coordinate difference. 

If the approximate coordinates are 

to be used to compute AX, AY and AZ, 


card 3 should be left blank. 
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4.1.4 Direction Constraint. 

When the direction between two stations i and j is to be constrained, 
it can be accomplished by applying weights to two angles a and 8 defining 
the direction between them. These angles are defined as 


a = 


tan’ 1 


AY 

AX 


where 

AX = Xj - Xj 
AY = Yt - Yj 
Az = Z t - z 3 

and 

i 

R = (AX 3 + AY 2 )^ 


; 


As with some of the other constraints, if the directions are to be 
computed from the approximate station coordinates, it is not necessary to 

I 

precompute a and 8. 

Four cards are needed to apply this constraint. The card formats are 
as follows: 



Columns 

Format 

Contents 

Card 1 

1-2 

12 

Constraint code, which is 4. 

Card 2 

1-5 

15 

Station number of first station. 


6-10 

15 

Station number of second station. 

Card 3 

1-16 

D16.8 

Alpha (a), in seconds. 


17-32 

D16.8 

Beta (8), in seconds. 

Card 4 

1-16 

D16.8 

Standard deviation of a, in seconds of arc. 


17-32 

D16.8 

Standard deviation of 8, in seconds of arc. 


33-48 

D16.8 

Covariance term, in seconds of arc 2 . 
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If the approximate coordinates are to be used to compute a. and o , 
Card 3 should be left blank. 

4.1.5 Constraint on Geodetic Latitude, Longitude and Height. 

This constraint can be applied to the latitude, longitude and height or 
to any one of the three. The main use for this constraint has been to 
apply height constraints to island stations where the orthometric height 
has been well determined, and the separation between the geoid and the 
reference ellipsoid is known to a certain degree of accuracy. It can also 
be used to define the origin of a network. This is identical in concept 


to constraint code 1 except here the 


Four cards are 

needed to apply 

are as 

follows : 



Columns 

Format 

Card 1 

1-2 

12 

Card 2 

1-5 

15 

Card 3 

1-16 

D16.8 


17-32 

D16.8 


33-48 

D16.8 

Card 4 

1-16 

D16.8 


17-32 

D16.8 


33-48 

D16.8 


coordinates constrained are ,X,h. 
this constraint. The card formats 

Contents 

Constraint code, which is 5. 

Station number of the station to ' 
be constrained. 

Latitude r p, in degrees and decimal 
degrees. 

Longitude X, in degrees and decimal 
degrees. 

Height h, in meters. 

Standard deviation of (p, in seconds 
of arc. 

Standard deviation of X , in seconds 
of arc. 

Standard deviation of h, in meters. 
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Any one, or all three of the coordinates can be constrained. If only one 
or two components are to be constrained, leave the field blank for the 
part not to be constrained. If the approximate coordinates are to be 
constrained. Card 3 should be blank. 

4. 2 Absolute Constraints 

The five absolute constraints are listed in Table 2. Three of these 
constraints use the inner adjustment equations, and for this reason a 
more detailed description is necessary r Blaha, 1971]. 

Whenever an adjustment is to be performed on a network of observing 
stations, it is necessary to define an origin, establish some form of 
orientation, and set a scale. With optical observations, the orientation is 
determined from the observations themselves, and with range observations 
the scale is determined from the observations. The inner adjustment 
constraint package was developed for use when the origin, orientation or 
scale was not known. An example of its use could be on a net of observing 
stations, each station on an isolated island in the ocean. If the observing 
stations were cameras, the origin and scale would have to be determined 
before adjustment. By applying constraint codes 11 and 13, the program 
would use the inner adjustment equations to get the best origin and scale 
possible from the geometry of the network and the observations themselves. 

Only one card is necessary to call any one of the inner adjustment 
constraints. This is the same as the first card of the weighted constraint 
package, which is the code number punched in columns 1 and 2 of the 
card. If the origin is to be defined, use code 11; for orientation, code 
12; for scale, code 13. Codes 14 and 15 are not operational, but the 
same results can be obtained by using constraints 1 and 3, using very large 
weights. 

4.3 Using Constraints Only in an Adjustment . 

In addition to the five different types of adjustment (the deck set-ups 
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of which are described in Figures 1 thru 5) it is possible to perform an 
adjustment without observations. This can be done by using constraints 
only. If there are enough constraints applied to tie all the stations to- 
gether, this is equivalent to forming a set of normal equations. In this 
computer program, the constraints are always added to the existing normal 
equations (see [Mueller, et al. , 1970], pp. 10-16 for a description of this). 
If the existing normal equations do not exist, the normal equations can be 
formed entirely from constraints. Care must be taken to insure that all 
stations are constrained properly. 

The deck set-up for solution using constraints only is shown in Figure 8. 
This is identical to the deck set-up for a solution only (see Figure 4) except 
the degrees of freedom card and the punched normal equations are replaced 
by a blank card. As with the solution only run shown in Figure 4, PCODE (1) 
must be set equal to 3 on the problem codes card. 


JCL (End of Deck) 


/ 


End Signal 


lV 


Blank Card 


End Signal 


Constraint Packet 


L 


End Signal 


Station Coordinate 
. Packet 



w 


End Signal 


Datura Packet 


. Problem Codes 


End Signal 


Title Packet 


JCL 



Figure 8. Deck Setup for Solution Using Constraints Only. 
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5. OUTPUT 


As far as the geodetic analyst is concerned, the most important part 
of an adjustment is the final results which are given in the printed output 
from the computer. However, there is more information included in this 
printout than the solution vector itself, and for this reason an explanation 
may be necessary. In this section of the report, the entire printed output 
is explained in detail. 

5.1 Output Common to All Adjustments. 

The first few pages printed on any adjustment are identical in format 
regardless of the type of adjustment. These pages contain the information 
input to the program on punched cards giving the description of the job 
itself, the problem codes, the datums involved in the adjustment, and the 
input coordinates of stations. Figures 9, 10, and 11 are samples of. the 
actual output for each of the items mentioned. It should be noted that 
at the bottom of Figure 11, there is written ’TEST DISTANCE = 5.00 
SECONDS OF ARC'. This one line will differ for the different types of 
runs. The above is written for optical data. With range data in the,, 
geometric mode it will be 'TEST VARIANCE = 3ome number', and for 
range observations in the orbital mode, it will be a printout of the 
coordinates of the center of mass and the uncertainties of these coordinates. 

5.2 Output from Geometrical Adjustment . 

5.2.1 Output of Optical Observations. 

When running the optical adjustment, all events are printed out as 
shown in Figure 12. As can be seen, the iteration number is printed, 
then the test distance and then for each of the events, the adjustment 
information. This is referred to as an event adjustment because it is 
truly an adjustment for the satellite position. There will be a maximum 
of six lines of information for each 2 station event, as is illustrated in 
Figure 12. 
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The first output line for each event is the number of the event. This 
numbering starts at 1 for the first event and continues on. The second ' 
line is the observational data from the first station in the event, plus 
the residual in seconds after the adjustment for the satellite position. 
Referring again to Figure 12, event 1, line 1, the information as one 
reads across the line is: 


9007 

9 20 27.8855 
9 Aug 65 
17 3 15.9510 
-4 51 32.9900 
2.00 


2.00 

0.00 


0.4 


Station Number. 

9 h 20 a 27f 8855 UTl 
Date 

17 h 3“ 15!9510 Right Ascension 
-4°51 / 32!'9900 Declination 
Standard deviation in right ascension, 
multiplied by the cosine of the declination, 
in seconds of arc. 

Standard deviation in declination, in seconds 
of arc. 

Covariance between acos 6 and 6, in seconds 
of arc, squared. 

The residual, in seconds of arc, after the ad- 
justment for the satellite position. 


There will be one line of information for each observation. The 

information printed on lines 4 and 5 of event 1 give the satellite position 

\ 

in XYZ coordinates plus the geodetic coordinates <p, X, h of the satellite. 
Either, or both, or neither of these two lines can be printed if the 
analyst so desires. This output is controlled by the value used for 
PC ODE (11) (see Table 1). 

The last line of each event gives a term referred to as GQI, and the 
RMS misclosure in meters. The term GQI stands for Geometric Quality 
Index, and is just the determinant of the matrix of normal equations used 
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in the event adjustment divided by the number of stations in the adjustment. 
It is used to give an idea of the conditioning of the matrix of normal 
equations; the smaller the GQI, the better the conditioning. 

The events listed in Figure 12 are excellent examples of good data. 
However, not all data is good, and several examples of this are shown 
in Figure 13. As was mentioned earlier in this report, the optical pro- 
gram can reject observations and still give a satisfactory adjustment 
provided that after all rejections there are still good observations from 
at least two stations. In Figure 13, events 2279 and 2280 each have one 
observation rejected, which is denoted by the * printed at the end of the 
printed line. In both cases, the other two observations were good and 
the events were acceptable. At the bottom of Figure 13, events 2310 and 
2311 were deleted due to insufficient number of good observations, which 
is the meaning of KODE = 2. If KODE = 3, it means that the deletion 
was due to insufficient geometrical separation between observations. 

5.2.2 Output of Range Observations, Geometric Mode. 

The output for the range observations, geometric mode, is almost 
identical in format to that of the optical observational data described 
earlier. A sample output is shown in Figure 14. The minimum number 
of stations required is 4. The adjustment for the satellite position is a 
least squares adjustment that iterates until convergence (maximum of 20 
iterations). Referring to the second line of event 2, Figure 14, the 
information as one reads across the line is: 


5401 

66 July 3 

1 31 43.9990 
2164169.973 
3.20 
- 1.12 


Station Number. 

Date (Notice that the order of the year and the 
day are the reverse of the optical printout. ) 
l h 31 m 43? 9990 time 
Range, in meters. 

Standard deviation of the range measurement. 

The residual, in meters, of the range obser- 
vation after the adjustment for the satellite position. 
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Figure 13. 
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Figure 14 



For the two events given in Figure 14, notice that PCODE (11) must have 
been zero (0) because of the fact that no satellite positions are printed. 

The last line of each event gives the variance of the event adjustment 
Go (Go = V'PV/d.o.f. ), in meters squared. Also, the number of iterations 
of the least squares adjustment is given. 

5.2.3 Output Common to All Geometric Adjustments . 

After the events are printed in either the range or optical geometric 
adjustments, there are quite a few options, and all of these options are 
controlled by the PCODES. The basic options of course are; do you want 
to form normal equations? If you do form normal equations, do you want 
to perform a solution? Then there are the secondary options; do you 
want to print the normals ? Do you want to punch the normals ? Do you 
want to simulate the guide matrix? Do you want to perform a summary 
by observed lines ? There are also several solution codes that are 
controlled by PCODE (16) thru PCODE (20). The analyst would be well 
advised to reread Table 1 to see just how all these options are initiated. 

If there are no normal equations formed and no solution to be per- 
formed, the words 'NORMAL TERMINATION* are printed and the program 
stops. If normal equations are formed, and if a solution is to be per- 
formed, the first set of information that is printed is the analysis of 
misclosures by station and a summary of information as shown in Figure 
15. It should be noted that these are the values prior to the addition of 
the constraints. 

If PCODE (6) = 1, the guide matrix is printed. This is just a matrix 
to show at a glance what stations co-observed, and the arrangement 
of the matrix of normal equations. Figure 16 is a sample guide matrix. 

The number 999 printed at the end of each line in Figure 16 is just an 
indication of the end of a row. When the normal equations are generated in 
the computer, the number 999 is used to indicate the end of a row. 
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Figure 15. 
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Figure 16. 

If PCODE (7) = 1, the normal equations are printed. The description 
of the normal equations was described in Section 3.2.3. The printout 
would be in the format as shown in Figure 6. 

If the inner adjustment constraints are used, the computer will print 
out one or more of the following messages: 

"THE ORIGIN OF THE COORDINATE SYSTEM IS DEFINED BY 
INNER ADJUSTMENT PROCEDURE. " 

"ORIENTATION OF THE COORDINATE SYSTEM DEFINED BY 
INNER ADJUSTMENT PROCEDURE." 


"SCALE OF THE COORDINATE SYSTEM DEFINED BY INNER 

ADJUSTMENT PROCEDURE." 

Another option available is the summary by observed lines, which can 
be had by setting PCODE (8) = 1. This is just a summation of the actual 
number of observations made by every two station combination in the 
network. Figure 17 is a sample listing. 

If a solution is to be performed, a set of constraints must be 
included in the data deck as described in Section 4. When the constraints 
are included, they are printed out after the summary of observed lines. 
Figure 18 is a sample of a partial listing. It is just a printout of the 
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original constraints, but with enough printed titles and labels to make the 
printed output easily understood by anyone. 

The description of the results after adjustment will be deferred until 
Section 5.4. 

5. 3 Output from Orbital Adjustment, Range Data. 

The output from an orbital adjustment differs in every respect from 
the geometric adjustment, except for the final parameter output for each 
station. This is necessary because in essence each event of a geometric 
adjustment corresponds to one pass of orbital information, and naturally 
orbital passes contain many more observations, etc. 

The first group of output common to all orbital adjustments is the 
input information itself as shown in Figure 19. This information is 
printed for every pass in the data deck. 

The second group of output data is the results of the adjustment 
of each pass for the first iteration (see Figure 20). Notice^ that the 
orbital elements printed at the beginning of each pass are the Apparent 
Celestial Cartesian Coordinates. Regardless of the original set of orbital 
elements, the program converts to this system for the adjustment. If 
the original orbital elements are very close to the actual elements, the 
resulting misclosures will be very small. However, the usual case is 
that the approximate orbital elements will cause fairly large misclosures 
(Figure 20 is a typical example). However, if the observations are good, 
the second iteration will have very small residuals. 

A good point to keep in mind when examining this particular portion 
of the printout is that the program has no way of rejecting bad observations 
in a pass, and even if an entire pass is bad, the program cannot reject 
it. It is up to the analyst to examine the misclosures for each obser- 
vation as well as the RMS misclosures for the pass, and to physically 
remove from the data deck observations which are bad, or even entire 
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- 52 - 



passes if the RMS misclosure is high. However, it is best to wait at 
least until the second iteration before removing data. 

After the listing of a complete iteration, there are several items 
printed, these particular items being identical to that of a geometric 
adjustment. These are the Analysis of Misclosures by stations, guide 
matrix, normal equations, observations on each line, constraints, and the 
summary by observed lines. Samples of these can be seen in Figures 6, 

s 

15, 16, 17 and 18. As always, the analyst can repress the printing of some 
of these by using the proper PC ODE. 

After all of the above items have been printed (or repressed, as the 
case may be), there is a listing of corrections to orbit and error model 
unknowns for each pass (see Figure 21). This is extrememly valuable, 
especially after the second iteration, to determine the quality of the orbits. 

This information should be used in conjunction with the listing shown in 
Figure 20, where at the bottom are given the uncertainties of these 
particular orbital elements. 

After the corrections to orbit and error model unknowns are listed 
come the results of the adjustment, which will be described in Section 5. 4. 

After that the next iteration begins (if there is a next iteration) and every- 
thing is repeated. 

5. 4 The Output of Adjusted Coordinated and Related Information. 

The most important part of any adjustment is the adjusted coordinates 

of the parameters and the standard deviations of these adjusted coordinates. 
The printed output from this program gives all this information and more 
for each station in the network. 

Prior to printing out the information for each station, a short tabulation 
is given listing degrees of freedom, V’FV, , and <j 0 . These values 
refer to the situation after the constraints have been added to the normal 
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UPDATED ORBIT ELEMENTS IN APPARENT SIDEREAL CARTESIAN 1 
POS IT ION (METERS ) -5839665.273 -3287685. 550 

VELOCITY! METERS/SEC) 1790.955731 3591.454590 


3 PASS 3 

CORRECTION VECTOR EPOCH® 28 JAN 69 11H 23M 56.0000S UT=MJD 40249.474953704 
-122.31373575 -88.52634812 -174.57801664 0.00583718 -0.04677484 -0.12510625 

UPDATED ORRIT ELEMENTS IN APPARENT SIDEREAL CARTESIAN COORDINATES 
POSITION (METERS) -6031421.514 -3762718.626 3248854.522 

VELOCITY! METERS/SEC) 1111.462937 3194.186825 6233.512894 


COORDINATES 

4071386.288 

5818.042513 


5 PASS 5 

CORRECTION VECTOR EPOCH® 28 JAN 69 23H IBM 56.0000S UT=MJD 40249.971481481 

99.79297248 98.72556723 -193.35861013 0.02146740 -0.07336664 0.14568621 


UPDATED ORBIT ELEMENTS- IN APPARENT SIDEREAL CARTESIAN COORDINATES 
POSITION (METERS) 4614260.193 5197589.926 3550155.041 

VELOCITY! METERS/ SEC) 3545.638267 725.030533 -6111.083214 


UPDATED COORDINATES OF THE CENTER OF MASS 

-311.854 191.895 -563.219 


Figure 21. 
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equations and the normal equations solved for the corrections to the parameters. 
A sample output is shown in Figure 22. 

The output of the adjusted coordinates of the parameters is identical for 
every type of adjustment, a sample of which is shown in Figure 23. As can 
be seen, the results are self-explanatory. The adjusted coordinates and 
standard deviations are given in both the Cartesian coordinate system and in 
the tp, X, h system with respect to the datum of adjustment. It should be 
mentioned here that the standard deviations are derived from the variance- 
covariance matrix multiplied by the value of cr |. 

Additional information printed is the direction of eigenvectors and 
square roots of eigenvalues of variance-covariance matrix. This may or 
may not be useful to the analyst. Another group of information is the 
off-diagonal elements of the weight-coefficient matrix as well as the correlation 
coefficients. 

A printout is made for each station in the network. After all stations 
are output, the program will return for another iteration, if there is to be 
another iteration. If this is the last iteration, the words 'NORMAL TERMI- 
NATION' will be printed as the last line of output. 
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Figure 22. 
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46.725036 -39.920902 -71.530350 -0.797291 -0.478285 -0.700819 
-0.624932 17.405108 -74.699018 -0.012557 0.245560 -C. 861838 
35.241776 5.129640 114.152416 0.46919? 0.047951 0.872624 


6. ADDITIONAL FEATURES 


The first five chapters of this report give the details of using the OSUGOP 
program. Although it has not been mentioned, it is possible to make changes to 
any or all of the subprograms that will not alter the subprograms on the disk. 

There have been many occasions where there was a need to modify certain parts 
of OSUGOP to perform a special type of adjustment. This is done by including 
the source version of the subprograms (with the appropriate changes made) as 
part of the deck setup. This requires a completely different set of JC L cards 
(see Appendix III). There have been other occasions where additional programs 
have been written to perform certain required tasks. These programs are run 
separately from OSUGOP, but the output can be used by OSUGOP. 

Although there have been many modifications used, probably the most impor- 
tant is the ability to read more than one set of normal equations and to perform 
an adjustment using all normal equations. Another very real problem is the 
ability to input correlatedj)bservations. The following is a brief description of 
the ways to handle these problems. 

6. 1 Addition of Normal Equations . 

It was mentioned in section 3. 2, 3. 1 that different systems of normal equations 
can be combined, and a description was given as to how they should be combined. 

At OSU there are two different techniques for adding normal equations. The one is 
a modification to the subroutine RDSOLN and the other is a separate program. 

The modification to RDSOLN is really just the addition of a DO LOOP that 
causes the program to keep reading normal equations. The deck setup is as shown 
in Figure 4 except that the degrees of freedom and V'PV, punched normal equations, 
and extra 999 card are repeated for each set of normal equations. At the end of 
the last set of normal equations the E card is inserted. 


\ 
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The separate program that adds normal equations has been called ADDITION. 

It adds normal equations together and then prints and punches the combined normal 
equations. In addition to this, different weights can be applied to the different sets 
of equations. 

6. 2 Forming Normal Equations Using Correlated Observations. 

The OSUGOP program was written to form normal equations from uncor- 
related observations. However, the observations from the NOAA BC-4 World- 
wide Network are in the form of Greenwich Hour Angle and Declination for up to 
seven ficticious images from each camera plate. These observations are the result 
of a polynomial fit, and there is a full variance-covariance matrix for all of the 
observations. In order to use this data, which was recorded on 17 magnetic tapes, 
a special program was assembled to read these tapes and form the normal equations. 
The normal equations are compatible to those described earlier in this report and 
OSUGOP was used to perform the solution from the punched normal equations. 

This program is described in f Mueller, et al. , in press]. 
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APPENDIX I 
Flow Diagrams 
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OPTICAL DATA, GEOMETRIC MODE. 
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RANGE DATA, GEOMETRIC MODE. 
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RANGE DATA, OPTICAL MODE. 
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APPENDIX II 

Brief Description of Subprograms 



Subprogram Listing 

This is a listing of all subroutines and functions used in the OSUGOP 

program and a brief description of what is done by each. If the subprogram 

is a function, the letter F will appear in parenthesis after the name. 

Name Purpose 

ANRADD (F) Converts degrees, minutes, seconds into radians. 

ASD 360 Processes optical directions. Reads data from 

disk, calls for the computation of satellite position, 
computes contribution to normal equations and 
contribution to V'PV. 

CLEAR Fills an array with Floating point zeros. 

CONAP Processes constraints on, and between, stations. 

Reads constraint codes, edits for wrong codes, 
calls CONAP1 and CONAP2. 

CONAP1 Processes weighted constraints, adds contribution 

to normals, V'PV, and djo. f. 

CONAP2 Processes absolute constraints, adds contribution 

' to normals, V^PV and d. o. f . 

DANG Converts radians to degrees, minutes, seconds. 

DEDIT Edits optical data based on preliminary station 

positions and deletes bad observations and bad events, 
based on the test distance criteria. 

DELL Used to compute AX, AY, AZ. 

Also propogates the error from the cartesian 
coordinates to the Geodetic coordinates. 

Takes the dot product of two vectors. 
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DPDOT (F) 



DRIVER 

Acts as the driving program for Orbit integration. 

EXPAND 

Expansion of Power Series coefficients, used for 
orbital runs. 

FOAN 

Forms normal equations for short arc mode processing. 

FORMRN 

Forms reduced normals for geometric mode 
processing. 

GSTD (F) 

Computation of Greenwich Sidereal Time 

KEPEQ 

Solves Kepler's Equation 

ICEPTCE 

Converts from Keplerian to Cartesian Orbit Elements. 

KSID2 (F) 

Stops the program if an observation is from a station 
not included in the list of input stations. 

K ST AID (F) 

Searches table of station identifiers for the internal 
number of a station. 

MAIN 

This is the driving program. Everything starts 
and stops here. 

MATRUP 

Updates the matrizant with respect to time. Used 
for orbital runs. 

MJD(F) 

Computed Modified Julian Day. 

ORBIN 

Orbit input subroutine. 

ORBIT 

Orbit integration controller. 

ORBRN 

Forms reduced normals for short arc mode 
processing. 

POLE 

Computes polar motions values x and y. 

PORB 

Prints updated orbital elements and Error Model Terms. 

PRENUT 

Computes precession and Nutation. 

PSOLN 

Prints the solution. 

RCONAP 

Reads the constraint cards and writes constraint 
information on a disk. 

RDSOLN 

Reads normal equations punched on cards and sets 
up storage for a solution. 
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RNG 360 


RODATA 

ROT 3 
RRDATA 

SATXYZ 


SOLVE 

STAIN 

SWITCH 

UPDATE 


UVWD 

UVWTG 

UVWTG2 

UVWTG3 

VARIEQ 


Processes range measurements. Accepts or 
rejects events based on test variance. Computes 
contribution to normal equations, V r PV and d. o. f. 
Reads the optical data cards, rotates into terrestrial 
coordinate system, puts all data onto a disk. 
Performs an R 3 rotation to a vector. 

Reads Range data input cards, puts all data onto 
a disk. 

Computes the satellite position from approximate 
station coordinates and three or more range 
measurements. 

Solves Normal Equations and computes inverse. 
Reads station coordinates and datum information 
from cards. 

Switches rows and columns in a matrix. 

Evaluates position and velocity at time t+ At, 
given the position and velocity at time t. Used 
for Orbital Solutions. 

Converts geodetic to rectangular coordinates. 
Converts rectangular to geodetic coordinates. 

Same as UVWTG. It is located in a different 
overlay. 

Same as UVWTG and UVWTG2. It is located in 
a different overlay. 

Generates the power series required to evaluate 
the matrix solution of variational equations. Used 
for orbital solutions. 
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APPENDIX III 
JCL 

(Job Control Cards) 
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JCL 


// { 10000, 1000 ), CLASSIC 

//STEP1 exec P ROC = FORT RANG » T IME= ( » 20 ) 

//CMP. SYS IM on * 


INSERT SOURCE SUBPROGRAMS HERE 


/* 

//STEP 2 EXEC PGM = IEUL ,PARF; = 'MAP ,L 1ST ,OVLY, I D» ,TIMF= ( 0, 20) 

//MYL IB OD DSM=SCJ032. MUELLER, DISP=SMR 

/ / SYSUT 1 DO UNI T = SYSOA»niSP= ( NFU , DEL ETE ) , SPACR = ( CYI. , ( 2, ]. ) ) 

//SYSLIR DO DSN=SYS1.F0RTLIR,DISP=SHR 
// DO D S M = S Y S 2 * F 0 R T S S P . 0 I S P = S H R 

//SYSPRIMT 00 SYS OUT =A 

//SYSLMOD 00 DSNAME=£GO (MAID ) , UN I T = S Y SO A , SP ACE = ( C YL ,(1,1,1)), 

// DISP=(NEW»PASS) 

//SYSLI N 0 0 (.) SNA M E = * • STEP 1. .CMP • S YSL I N , D I SP = ( f)L D ,0 ELE TE ) 

// OD * - 

ALIAS GEOHSG 

INCLUDE MYL IB (GEOHSG) 

OVERLAY ALPHA 

I MS E R T OB S D , M J D , P R E MU T , P 0 L E , G S T 0 , S T A P L H , D P D 0 T , A M R A D D , IJ V W T G 2 

INSERT R CONAP , K S I D2 

INSERT STA IN ,IJ\/'M) 

OVERLAY GAMMA 

I NS E RT ROD ATA , AS 03 60 , DEO I T , D ED I TC 
OVERLAY GAMMA 

I [- ! S E R T R R D A T A , R N G 3 6 0 , S A T X Y Z , R A U G E D 
OVERLAY GAMMA 

INSERT E P. DCOM , OR 13 COM , ORB PAR , ORBIT, E XP AN 0 , VAR I EO , IJPDATF 

INSERT CLEAR 

INSERT ORB IN ,KEPTCE , KEPEO, RQT3 

INSERT FOAM, DRIVER, MATRUP 

OVERLAY ALPHA 

INSERT NORM EO 

OVERLAY BETA 

INSERT ORRRN 

OVERLAY BETA 

INSERT FOR M R N 

OVERLAY BETA, 

INSERT RDSOLN 
OVERLAY BETA 

JCL required when a subroutine (or subroutines) is different from that on 
the disk. This does not change the subroutines on the disk, but merely 
overrides them. 
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JCL (Continued) 


INSERT CONAP 

OVERLAY DELTA 

■ INSERT COM API? UVWT 03 

OVERLAY DELTA 

INSERT CONAP 2 

OVERLAY BETA 

INSERT SOLVE, SWITCH 

OVERLAY ALPHA 

INSERT PORB 

OVERLAY ALPHA 

I M S E R T P S 0 L N , D A N 0 , U V W T G ,.D E L L , D E I G E N 

/ 

//GO EXEC PGM = * • STEP? . SYSLMOD » T IMF = ( 04,20 ) ,REGION = 252K 
//FT01F001 on 0 N I T = S Y S D A » S P AC E = ( C YL ,(1,1)) , DISP = ( NEW, DELETE ) , 
// DCB= ( L RECL =400 , ft LKS I ZE =404 , RE CF 0= VS ) 

//FT02F001 DO UN I T = S YSDA , SP AC E = ( C. YL , ( 1 ,1 ) ) , DISP = ( NEW, DELETE ) , 
// DC B= ( L RECL =404 , 8 LKS I ZE =4 1 2 » RECF M= VS ) 

//FT03F001 DO UN I T =SYSDA , SP ACE= (C YL , ( 1 * 1 ) ) , D I SP* ( NF W, DELETE > , 
/ / D C B = ( L R F C L = 4 0 0 , B L K S I Z E = 4 0 4 , R F C F M = V S ) 

/ / FT04F00 1 DD UNIT =SY$DA ,SP ACE = (CYL , ( 1 , 1 )) , D I SP = < NE W, DELETE ) , 

// DC B= ( L RECL = 400 , R LKS I ZE =404 , RE CF M= VS ) 

//FT06F001 DO SYS0UT=A -• 

//FT07F001 DD SYSOUT=R 
//FT05F001 DD * 


INSERT DATA HERE 


/* 

// 
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// ( 2000,200) tCLASS=R 

//JORLIR no nSNAMF.= SCJ032.MUFLLFR»DISP' = SHR*PARM=' 10' 

//GO EXEC. PGM = OS H GO P » f I M P = 2 

/ / FTO 1 FOO 1 00 UN IT =SYSDA , S P AC F = ( C YL , ( 1 , 1 H , 0 I $P = ( NF H , 0 F|_ ET E } , 

// DCB= ( LRECL=400,RLKS IZE=404, RFf.FM=VS ) 

/ / FTO 2 FOO 1 DO UN IT =SYSOA , SP ACF_ = ( C YL , <1 , 1 ) 1 , 0 I SP = < NE W, DELETE ) , 

// DC B = ( I. RFCL =408 » R LKS I ZF =4 1 2, RECF M= VS ) 

//Ft03F001 on UNIT =SYSDA » SP ACF.= ( CYL , < 1 , I )) jDISP=(NEW, DELETE ) * 
// DC 8= ( L R ECL =400 , B LKS I ZF =404 , RECF M= VS ) 

/ / FT04F001 00 UNIT =SYSDA »SPACE = (CYL ,11,1)) , 01 SP = { NEW, DELETE ) , 

// DCR= ( LRFCL=400, BLKSI ZE=404, RFCFM=VS ) 

/ / FT 06 FOO). 00 S YSOUT =A 
//FT07F001 00 SYSOUT=B. 

/ / FT05F00 1 DO * 


INSERT DATA HERE 


/ * 
// 


JCL required to use the standard program on the disk. 
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APPENDIX IV 

« 

Fortran IV Program with Subroutines 
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PROBLEM r.nilF DFFI'VITinMS 

COLUMN MEAN IMG 

1. O u ERALL PROBLEM CODE 

PCOOE (!.)=! MEANS OPTICAL PROGRA'-' 

?. DEANS RA.HpF 

3 MEANS SOL* 'T ION ONLY RUM 

4 NE A M S ORBITAL iiPOF, OPTICAL observations 
s MEANS ORBITAL MOOT. RANGE OBSERVATIONS 

6 OrA'iS ORBITAL WOOF , MIXED OBSERVATIONS 
PCOOEl 1 ) =7 N-FANS OPTICAL PROGRAM, GEOMETRIC HOOF ( GEOS FORMAT) 

2. PERFORM SOLUTION? 

PCOOE I 2 ) =1 DEADS YES 
0 i-.E/o-'S NO 

PCPDFU. )=3 IMPLIES PCnnE(2)=l 

5. MAXIMUM f -M Ip REP. OF ITERATIONS? 

PCOOE ( 1 ) MOST FOOAL I OR ?, 

PcnnE(2) must fomal i, * 

PCOOE ( 5 ) KUST FOOAL 1, FOR ONF OR MORE COMPLETE ITERATIONS 

3. FORM NORMALS? ' • • 

PROCESSING COOES 

1 MEANS Y F S t 0 MEANS NO 

6. SIMULATE GIIIOE MATRIX? 

7. PRINT NORMALS? 

K. PERFORM SUMMARY BY OBSERVED LI : '* : S? 

9. PUNCH NORMALS I M AS*'' FORMAT? 

10. SUMMARIZE RESULTS 

PC.ODFI 101=0 no NOT PRINT SUMMARY 

= 1. pp.jNT THE I'X'S ai.mi stamoaPH OE VI AT IONS 
= 2 PRINTS THE X,Y,Z'S AND ST A Mn A P 0 OHVIATIONS 
= 3 PRINTS THE L AT I T* 'OF i LO'-'G! TI'OF AMO HEIGHT 
=4 PRINTS BOTH X , Y , Z S LAT.,L n NG, K H 

11. PRINT SATELLITE POSITION FOR EACH EVENT? 

0 MEANS NO 

1 .MEANS PRINT XYZ AMO OF OOF T ! C COORDINATES 

2 MEANS PRINT XYZ ONLY 

3 MEANS PRINT GEODETIC COOROI MAT ES ONLY 

12. THIS PARAMETER 0 F S 0. !•’ T N S '-'MFRF thf STANDARD DEVIATIONS OF THE 

INOIVinilAL 0PS c P v/. T ion S (USED TO FOP M THF '-'EIGHTS) ARE TO RE FOUND 
PCOOE IIP) =0 MFA* ! S TO RE AO THE OBSERVATIONAL STANDAP.n DEVIATION 
FROM THE CARD CONTAIN JMP THE OBSERVATION. 

PCOOE ( 12 )=1 MEANS To ASSOCIATE A SINGLE STANDARD DEVIATION WITH 
ALL ORSERVAT IO“*S FROM A GIVEN STATION.## THE STANDARD DEVIATIONS 
TO P.F A SS n C I AT ID I TI-* EACH STATION ARE GIVEN IN COLUMNS 73-79 OF 
THE CAP 1 ' C n f 'TA I*’' I*-'*) THE INPUT Cn n SDI MATES OF THE STATION. 

PC f| OE ( 12 ) =2 MEANS TO ASSOCIATE A SIUftl.F STANDARD DEVIATION HITH 
ALL DR SSPVAT IO'-'S . ** “HIS NHr'HF ? TS FOUND IN COLS. 21-30 OF THE 
CARD CONTAINING THE TEST DISTANCE (OPTICAL) OR TEST VARIANCE 
( RANGE ) . 

IN thf CaSF of OPTICAL n~SER u ABTinMS , THIS MUH3ER IS INTERPRETS 


- 81 - 


v - ) n o o o 


c A S THE STANDARD DEV I A I ON OF THE DECLINATION AMD OF THE RIGHT 

C ASCENSION TIMES THE COS I MS OF THE DECLINATION, AMD THE 

C COVARIANCE IS SET TO ZERO. 

C COOES WHICH APPLY TO ORBITAL NODE PROCESSING ONLY 

C 14. TREAT COORDINATES OF CENTER OF MASS AS UNKNOWNS? (ORBITAL MODE 653Y 

C 15. PUNCH UPDATED MRDJT ELEMENTS? (ORBITAL MODE ONLY) 

C 

C 

r. SOLUTION CODES 


c 

c 

c. 

c 

c 

c 


16. WRITE NORMALS AN n INVERSE DURING SOLUTION PROCESSING? 

( ) M E A NS P R I N T N OT K T W G 

1 MEADS PRINT PIVOT ELEMENTS 

2 MEANS ALSO PRINT NORMALS AND INVERSE 

3 MEANS ALSO PRINT REARRANGED NR 0 HALS AND INVERSE 

17. PUNCH ADJUSTED STATION XYZ AND VARIANCES FOP INPUT TO BADEKAS 1 

DATUM TRANSFORMATION PROGRAM? 

18. PUNCH ADJUSTED STATION POSITIONS? 

19. COMPUTE EIGENVECTORS OF VARIANCE-COVARIANCE MATRIX 

20. COMPUTE CORRELATION COEFFICIENTS 


COMMOM/NST A /NS T A 

INTEGER*? ENDS IG/1HE/* CDNT I M 

INTEGER-2 PC.ODE ( 2D ) 

C OH H 0 N / P C 0 D E S / P C O D E 
REAL-3 TITLE! 10) 

3 CONTINUE 

UR IT-( 6,600). ) 

6001 FORMAT ( 1H1 , 20 ( / ) ) 

4 P. F a D (5,50DJ. ) TITLE, C ON T T N 
5 0 0 1 F 0 R M A T ( 9 A 8 , A 7 , A ). ) 

I F ( C ON TIN.EP.E NO S I G ) GO T 0 5 
WRITE (6, 6012) TITLE " 

6012 r 0 RMA T ( 3 OX , 9 A 8 , A 7 ) 

GO TO 4 

5 CONTINUE 

READ ( 5 , 5050 ) PC.ODE 
5050 FORMAT! 80 1 1 ) 

WRITE ( 6 , 6050 ) PC DDE 

6050 FORMAT ( ////10X, ’ PROBLEM CODES • , !0X , 20 I 1 ) 
CALL STAIN 
J = PCODE ( 1 ) 

GO TO ( 100, 200, 300, 400,5(10,600, 1O0), JCOOE 
1.00 CALL ROD at A 
Gil TO 105 
200 CALL HR DAT. A 
GO TO 105 
500 CALL ORKIN 
GO TO 105 

10 5 I F < PC 00 E ( 2 ) . E P . 3. ) C A L L RC DM A p 
N.ITR = PC0DE(3) 
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DO HO I =1,0 IT R 
'■'RITEt 6,6010) I 

MHO FORMAT! 1H1///2PX, ’ ITER/'T ino ' , 15 ) 

0 !‘l I!*’ OPTICAL 

I F ( JCCOE . F.o. I ,r.i> . jcn\ 'E . p .o.7 ) r./‘|_L ASOriAO 
C RU M R A i--i • ;i-_ |>:-;i ipr>/,!,- 

I F | JCOHC.FO,?) CAL!. RHP360 
IF ( JCC-OF. IR'.F ) CALL FDA'- 1 
I <= ( PC OP F ( 5 ) . OF . 1 ) r,n yn p 90 
IF ( JCOOR.LT.?' .HP . jr.ni'iF. <-n. 7 ) CALL F I! 

I F ( JCuOF . GT. ?. JCnr-F.LT. 7 ) CALL npur-M 
ASS I CO 110 T'"- J?.T M 
r.n Tn poo 
110 CONTINUE 
(;n T n 8 v 0 
300 cni'T TOUR 

CALL RCI>‘AP 
CALL RDSL'LH 
ASSI Civ890 TO JRTM 
' GO TO 800 
■300 CONTINUE 
CALL COMAP 
CALL SOLVE 

IF 1 JCODF.GT . AMD. JCOPF .LT .7 ) CAD. POPP. 

CALL PSOLM 

GO TO JKTW, ( 1 10, 890) 

600 CPMT J.MifE 
400 COOT IMi.lF 
8 90 Cn.MTIivUe 

W R ITE ( 6, 6002 ) 

6002 FORMAT ( // ' ONORKAL TFHM I MAT III'-' > /li-ll ) 

STOP 
6 HD 
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DOUBLE PRECISION FUNCTION DPDOT(X.Y t N) 
DOUBLE PRECISION X(N),Y(N) 

0PD0T=0.0 
DO 10 1=1, N 

10 DPOOT=DPDOT+XU)*YII) 

RETURN 

END 
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SUBROUTINE FORMRN 
IMPLICIT REAL*8(A-H,0-Z) 

COMMON /NSTA/NSTA 

INTEGER*2 PC0DE(20I 

COMMON /PCODES/PCOOE 

COMMON /WPW/WPW,XPU,IDEGF, IFSTA 

DIMENSION DON (3. 3) »0DK(3) ,L1(3> ,L2t3) , BN DON 1 1 3 .3) , TNI 3,3) ,TK (3) 

INTEGER*2 L.LSOLVE 
INTEGER CONT1N, ENDSIG/IHE/ 

COMMON/STAORD/KORDERI 150) 

COMMON /NORMEQ/REDN<3,3,820) ,U(3 ,40 ) , L( 820) , LSOLVE 
DIMENSION BN(3,3,40) ,LG<40) 

C FORM REDUCEO NORMAL EQUATIONS FOR UP TO 40 STATIONS 
DIMENSION KSTATEI40) 

L0CIK)=IK*lK*l>)/2 
MAXSTA=40 

IFINSTA.GT.MAXSTA) GO TO 901 

THE REDUCED NORMAL EQUATIONS ARE STORED AS 3 X 3 BLCCKS IN THE ARRAY REDN. 
ONLY THE UPPER TRIANGULAR PART OF THE REDUCED NORMAL EQUATIONS IS STORED. 
THE BLOCKS OF THE REDUCED NORMAL EQUATIONS ARE NUMBERED 


ACCORDING 

TO 

THE 

FOLLOWING SCHEME: 

1 2 

4 

7 

11 

3 

5 

8 

12 


6 

9 

13 



10 

14 




15 ET CETERA 


L ( 820 ) IS THE GUIDE MATRIX 
L=1 SIGNIFIES A NON ZERO BLOCK 

L=0 SIGNIFIES A ZERO BLOCK 

IB=LOC (NSTA) 

DO 100 JB=1,IB 
DO 99 1=1,3 
DO 99 J=1 ,3 
99 REDN I I ,J, JB)=0.0 
100 L<JB)=0 

BACKSPACE 2 

READ(2) ( ( (BN(I,J*KSTA),I=1,3),U(J* KSTA ) , J=l, 3) , 

XKSTA=1,NSTA) 

REWIND 2 

STASH DIAGONAL BLOCKS 
DO 110 KSTA=1,NSTA 
IB =LOCCKSTA» 

DO 108 1=1,3 
DO 108 J=l,3 

108 REDN( I , J , I B ) =BN ( I , J, KSTA) 

110 CONTINUE 

FDEGF=IDEGF 

I FI PCOOEI 9 ) .EQ .1 ) WRITE 1 7, 70 10) FDEGF,WPW 
7010 FORMAT ( 16X, 2F16.6) 

READ BLOCKS FROM EACH EVENT AND REDUCE NORMAL EQUATIONS 
150 READI2 ) NSTE ,DON ,DDK,( ( (BN( I ,J , IS) ,1=1,3) *J=1,3), 
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c 


1KST ATEI IS) * I S=1,NSTE) ,CONTIN 


DO 180 I S=1 »NSTE 
ISTA=KSTATEI IS) 

IB=ISTA 

CALL DGMPRD I BNI 1 , 1 , IS ) ,DDN,BNDDNI ,3,3,3) 

CALL DGMPRD ( BNODNI ,DDK,TK,3,3,1 ) 

DO 155 1=1 »3 

155 UII,ISTA)=UII,ISTA)-TKII) 

DO 180 JS=1 »NSTE 
JSTA=K$TATEIJS) 

JB=JSTA 

SKIP IF IISTA.GT.JSTA) , SINCE ONLY THE UPPER TRIANGULAR PART OF THE 
REDUCED NORMAL EQUATIONS IS BEING COMPUTED AND SAVED. 

IF( ISTA.GT. JSTA ) GO TO 180 

( IB, JB) GIVES THE ROW AND COLUMN NUMBER OF THE BLOCK IN THE REDUCED 
NORMAL EQUATIONS CURRENTLY BEING PROCESSED. 

SET INDICATOR 
NB=LOC ( JB— 1 ) 

NB=IB+NB 
LINB)=LlNB)+l 
PERFORM REDUCTION 

CALL DGMPRDIBNDDNI,BNll,l, JS),TN,3,3,3) 

DO 130 1=1,3 
DO 130 J=I,3 

130 REDN( I »J,NB )=REDNI I * J»NB )-TN( I , J ) 

180 CONTINUE 

IF END OF DATA, GO OUT OF LOOP 
IF (CONTIN. EQ.ENDSIG) GO TO 400 
IF NOT, RETURN TO PROCESS ANOTHER EVENT 
GO TO 150 

ENTER HERE WHEN ALL EVENTS HAVE BEEN PROCESSED. 

400 CONTINUE 

SIMULATE KRAKIWSKI • S GUIDE MATRIX 
I F( PCODE ( 6 ) »NE. 1 ) GO TO 441 
C 

WR ITEC 6,6001) 

6001 FORMAT (1H1, 10(/> , 20X, 'GUIDE MATRIX*) 

DO 440 ISTA=1 »NSTA 

I B=0 

LGI1)=1000 

DO 435 JSTA=I STA»NSTA 
JB=LOC C JSTA— 1) + ISTA 
IFIL(JB) .EQ.O) GO TO 435 
IB=IB^1 

LGI IB)*KORDER( JSTA) 

435 CONTINUE 
C 

IB= IB*1 

IF(IB.GT.l) LGI IB ) =999 

439 WRITEC 6,6002 ) KORDERI ISTA) , C LGI I) , 1=1, IB ) 

6002 FORMATI20X, 15, 5X, 1815, 200I/30X, 1815) ) 

440 CONTINUE 

441 CONTINUE 


C 
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C PRINT NORMALS IN ASO FORMAT, AND PUNCH IF DESIRED. 

HRIT6I6, 60031 

6003 FORMAT ( 1H1//* NORMAL EQUATIONS (SEE GUIDE MATRIX)*//) 

DO 450 ISTA=1,NSTA 

DO 442 1=1,3 

442 DDK ( I ) =-U ( I , I ST A ) 

I B=0 

JB=LOC(ISTA) 

1F(L( JB) .GT.O) IB=1 
C PUNCH NORMALS 

I F ( PCODE (9 ) . NE. 1 ) GO TO 443 
WR I TE ( 7, 700 I ) KORDER ( ISTA ) 

7001 FORMAT ( 1415) 

WRITE (7, 7006) DDK 
7006 FORMAT (3(F16.10,5X)) 

WRI TEC 7,7008) ( ( REDN ( I , J, JB) , J=l,3) ,1=1,3) 

7008 FORMAT (3F16.10/3F16.10/3F 16. 10) 

C 

443 CONTINUE 

C PRINT DIAGONAL BLOCK 

I F( PCODE ( 7) .NE .1 ) GO TO 444 
WR I TE ( 6,6004) KORDER ( ISTA ) 

6004 FORMAT { // 1 5 > 

WRITE (6,6006 ) DDK 

6006 FORMAT (/3(F16.10,5X) ) 

WRITE (6, 6008) ( ( RE ON ( I , J, JB ) , J=1 , 3 ) , 1=1 , 3 ) 

6008 FORMAT (3F16.10) 

444 CONTINUE 

C PRINT OFF-DIAGONAL BLOCKS 
KST A=I STA+1 

IF( ISTA.EQ.NSTA) GO TO 448 
DO 445 JSTA=KSTA,NSTA 
JB=LQC(JSTA-1)*ISTA 
IF(LUB).EQ.O) GO TO 445 
IB= IB*1 

IF ( PCODE (9) .NE.l ) GO TO 7445 
WRI TE ( 7,7001 ) KOROER ( JSTA ) 

WR I TE( 7,7008 ) ( ( RE DN ( I , J , J B J , J=1 , 3 ) , 1=1 , 3 ) 

7445 CONTINUE 

I F ( PCODE (7) .NE.l ) GO TO 445 
WR I TE( 6,6004) KORDER (JSTA ) 

WRI TE( 6,6008 ) ( ( REDN ( I , J, JB ) , J=1 ,3 ) , 1=1 , 3 ) 

445 CONTINUE 
448 1=1000 

IF(IB-GT.O) 1=999 
IF ( PCODE (7) .EQ. 1 ) WR I TE < 6 , 6004 ) I 
I F ( PCODE (9) . EQ • 1 ) WR I TE ( 7, 7001 ) I 
450 CONTINUE 

IF( PCODE! 8) .NE.l) GO TO 478 
WR I TE (6,6010 ) 

6010 FORMAT ( 10 ( /) , 20X, ’OBSERVATIONS ON EACH LINE*) 

IB=NSTA-1 

DO 475 I STA=1 , IB 

KSTA=I STA+l 

DO 475 JSTA=KSTA,NSTA 

WRITE! 6,6011) KORDER! I STA ) , KORDER ( JSTA ), l (LOCI JSTA-1 >♦ ISTA ) 

6011 FORMAT (8110) 

475 CONTINUE 
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478 CONTINUE 
RETURN 

901 CONTINUE 

WRITE! 6,9001 ) MAXSTA.NSTA 

9001 FORMAT! • FORMRN IS PRESENTLY DIMENSIONED TO HANDLE ONLY*, 1 5, 

l* UNKNOWN STATIONS. */20X, • THIS PROBLEM HAS* ,15, ' UNKNOWN STATI 
210NS.*/10X, 'EXECUTION IS TERMINATED BY PROGRAM.*! 

STOP 

END 
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SUBROUTINE ROSOLN 

C THIS SUBROUTINE READS THE NORMAL EQUATION FROM CARDS AND SETS UP 
C STORAGE FOR A SOLUT ION ,S I MULATI NG STORAGE AFTER EXECUTION OF FORMRN. 

C THIS SUBROUTINE IS CALLED ONLY FOR A SOLUTION-ONLY RUN. 

C THE INPUT IS COMPATABLE WITH KRAKIWSKI'S SOLUTION PROGRAM. 

C THE STATION COORDINATES MUST BE INITIALIZED BY CALLING STAIN. 

IMPLICIT RE AL*8 ( A— H»Q— Z ) 

INTEGER*2 L.LSOLVE 
INTEGER ENOSIG/1HE/,CONTIN 

COMMON /NSTA/NSTA/STAORD/KOROER( 150 ) /WP W/WPW ,XPU» 10EGF , IF ST A 
COMMON /NORMEQ/REDN (3 ,3,820), U(3,40)»L( 620),LS0LVE 
INTEGER*2 PC0DE(20) 

COMMON /PCODES/PCODE 
LOC (K)=(K*(K+1) )/2 
C 

NB=LOC (NSTA ) 

DO 10 IB=l,NB 
L ( IB)=0 
DO 10 1=1,3 
DO 10 J=l»3 
10 REDNII ,J,IB)=0.0 
DO 12 IB=1»NSTA 
DO 12 1=1,3 
12 U( I ,1B)=0.0 
C 

READ! 5 , 5001 ) VUW, FDEGF, WPW 

5001 FOR MAT (30 16 .8 1 
IDEGF=FOEGF 

READ NORMALS AND STORE 
100 R E AD( 5 1 5002 ) 1D.C0NTIN 

5002 FORMAT( I5.74X.A1) 

I F ( ID. EQ .999 ) CONTIN=ENDS IG 
IF(CONTIN.EQ.ENOSiG) GO TO 600 
I ST A=KSTA1D (ID) 

I F ( ISTA.LE .0 ) GO TO 900 

READ CONSTANT COLUMN 

READ( 5 . 5003 ) (U( I . ISTA) . 1=1,3) 

SWITCH SIGN 

DO 110 1=1,3 
110 U( I , ISTA ) =— U( I , ISTA) 

RE AO 01 AGONAL BLOCK 
NB=LOC (ISTA) 

READ(5 .5004) ( ( REDN ( I , J , NB) , J=1 ,3) , 1=1,3) 

5003 FORMAT (3(D16.8,5X) ) 

5004 FORMAT ( 3D 16.8 ) 

L ( NB ) =1 

READ OFF-DIAGONAL BLOCK 
150 READ( 5 , 5002 ) ID 

I F ( ID. EQ. 999 ) GO TO 100 
JSTA=KSTA I 0 ( ID) 

I F ( JSTA.LE.O) GO TO 900 

SWITCH SUBSCRIPTS IF NECESSARY SO THAT STORAGE IS MADE IN UPPER TRIANGULAR P 
PART OF REDUCED NORMAL EQUATIONS. 

IF(JSTA.GE.ISTA) GO TO 160 
NB =LOC ( I STA-l ) ♦ J ST A 

REA D( 5, 5004) ( ( REDN( J, I , NB ) , J=1 , 3 ) , I =1 , 3 ) 
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GO TO 170 
160 CONTINUE 

NB=LOC< JSTA-miSTA 

READ! 5 , 5004 ) ( ( REDN< I , J ,NB) , J=1 ,3 » , I =1 * 3 ) 

170 CONTINUE 

6001 FORMAT (315) 

LtNB)=l 

GO TO 150 
C 

900 WRITEI6.6000) 10 

6000 FORMAT ( 'OSTATION NUMBER NOT FOUND IN INPUT LIST', 16,' PROGRAM STOP 
IS.* ) 

STOP 

C 

600 CONTINUE 

I FI PCOOEI 7) .EQ.O) GO TO 620 
WRITE! 6,6003 ) 

6003 FORMAT! ///T30 , 'NORMAL EQUATIONS') 

DO 615 ISTA=1,NSTA 

WRITE! 6,6002) KORDER 1 ISTA ) , 1ST A 

6002 FORMAT ! ///3I 10) 

WR I TE! 6,6004 ) I U!I, ISTA), 1=1, 3) 

DO 615 JSTA=ISTA,NSTA 
NB=LOC ! JSTA— 1 ) +ISTA 

WRITE! 6,6002 ) KORDER! ISTA) .KORDER! JSTA) ,NB 
WRITE! 6,6004) ! 1 REDN 1 1 , J, NB ) , J=l,3 ) , I =1 ,3 ) 

6004 FORMAT !3F 16. 10) 

615 CONTINUE 

620 CONTINUE 
RETURN 
END 
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SUBROUTINE STAIN 
IMPLICIT REAL*8(A— H»0— Z) 

INTEGER*2 PC0DEC20) 

COMMON /PCODES/PCODE 
INTEGER ENDSIG/lHE/yCONTIN 
COMMON/NSTA/NSTA 
COMMON/ST AORD/KORDER (150) 

INTEGER STANAM, I0S*2 
INTEGER*2 PLUS/1H-*-/ 

INTEGER*2 I SGNP, IPHID, I PHIM,LONGD,LONGM, ISGNL 
COMMON /STALOC/STAUVW (3 y 150) yDATPRM (2 y 1 5 ) ,OATNAM( 4, 15 ) , 

1STANAM (5 y 150 ) , 1DS( 150) 

DIMENSION UNCE(3) 

C UNCE FOR THE MOMENT IS A DUMMY ARRAY 

COMMON/STAPLH/STAPLHl 2, 150) 

COMMON /0BS0/0BSD( 150 ) yOVOBSO 

MAXSTA=150 

WRITE(6,6000) 

6000 FORMAT (1H1) 

6001 FORMAT ( 1H1 y 20 ( /) ) 

WR 1TEI 6y6002 ) 

6002 FORMAT ( //// /4X»29HDATUMS INVOLVED IN ADJUSTMENT,//) 

C INPUT DATUMS 

10 READ(5,5002) IDD, AE,BE,CONTIN 

5002 FORMAT! I 2 ,2F 12 .3 , 53X y A1 ) 

I F ( CONTI N • EQ • END S I G ) GO TO 30 
DATPRM! 1 , IDD) =AE 
D ATPRM ( 2 , I DD ) =BE 

READI5 y 5003 > (DATNAM! I y IDD) ,1=1,4) 

5003 FORMAT (4A8) 

WRITE! 6,6003) IDD, (DATNAM ( I , IDD) , 1=1 ,4) , < DATPRM! I, IDD ) , 1=1 ,2 ) 

6003 FORMAT (6H0DATUM, I 3,3X,4A8 »3HA= ,F10.2,12H METERS B= ,F10.2, 

17H METERS) 

GO TO 10 
C 

30 CONTINUE 

C STATION INPUT 

WRITE! 6,6005) 

6005 FORMAT! 1H1///40X,29H INPUT COORDINATES OF STATIONS) 

KSTA=0 

35 KSTA=KSTA+l 

READ! 5, 5005) I DD, IDTS, ! STANAM! I ,KSTA ) , 1=1,5) ,ISGNP,IPH ID, IPHIM, PHIS 
1 , LONGD , LONGM , FLONGS, HyUNCE ,OBSD !KSTA ) yCONTIN 
5005 FORMAT! I4,I2»4A4,A2,A1,2(2I3»F8.4), F10.2,3F3.1,F7.2,A1) 
IF1C0NTIN.EQ.ENDSIG) GO TO 50 
PHI =ANRADDI I SGNP , I PH ID, I PHIM , PHIS ) 

I SGNL-PLUS 

F LONG 2 ANR ADD! ISGNL , LONGD, LONGM, FLONGS) 

KOR DER ( KST A ) = I DD 
IDS(KSTA)=IDTS 
STAPLH ! 1 »KSTA ) =PHI 
STAPLH12,KSTA)=FL0NG 

CALL UVWD I DATPRM! 1 , IDTS) yDATPRM 12 , IDTS ) ,PHI , FLONG, H, STAUVW 1 1 ,KSTA) 
1,STAUVW!2,KSTA),STAUVW13,KSTA>) 

WRITE (6,6006) IDD, (STANAM! I ,KSTA ) , 1=1 ,5 ) , I DTS , ( DATNAM ( I , 10TS) ,1=1,4 
1) , I SGN P, I PHID, I PHIM, PHIS, ISGNL, LONGD, LONGM, FLONGS, H 

6006 FORMAT! 1H0, 14, 8X ,4A4, A2, 10X, 5HDATUM, I4,4X,4A8/10X,20HGEODETIC COOR 
10INATES,2(6X,Ai,2I3,F8.4) , F12.4) 
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WRITE 16,6007) I STAUVWI I ,KSTA) , 1=1 ,3) 

6007 FORMAT ( 10X »21HCARTESI AN COORDINATES, 3F16. 3) 
GO TO 35 
£0 CONTINUE 
NSTA=KSTA— I 
NST AUN=3*NSTA 
REWIND 3 
RETURN 
END 
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SUBROUTINE ASD360 

C S/360 VERSION OF ASD PROGRAM FOR OPTICAL SATELLITE DIRECTIONS 
IMPLICIT RE AL*8 ( A— H»Q— Z) 

INTEGER*2 PC0DEI20) 

COMMON /PCODES/PCODE 

' INTEGERS ENDSIG/lHE/»CONTIN»DELCOD( 2)/lH »1H*/*EC0DE 
INTEGER*2 PLUS/1H*-/ 

I NTEGER*2 I SGNP , I PHID , 1 PH IM , LONGD , LONGM , I SGNL 

INTEGER*2 I D( 50) ,KEY (501 , IHR <50 ) ,MIN( 50 » , IDAYI 50) , IYR ( 50 » , IR AH (50) 
1* IRANI 50), ISGNDI 50) * IDECD(50) » IDECMI 50 ) » IDATI 50, 11 ) 
C0MMCN/DEDITC/ALFS(50) ,DEC ( 50) , U( 3 ,50) ,SC 3 ) ,D( 50 ) , SDC (3,50 ) , EVSUM, 
IGAST,STAXYZ (3,50) ,GQI, 

2T0,KSTATE(50),IPASS(50),NSTE,NSUSED,EC0DE 
COMMON /NS TA/NSTA 
INTEGER STANAM, IDS*2 
DIMENSION MONTH (50) 

C0MMCW/STAL0C/STAUVW(3 » 150) , DATPRM (2, 15 ) , OATNAM( 4, 15) , 

1 STANAM (5,I50),I0S(150) 

COMMON/STAORD/KORDER ( 150 ) 

EOU IVALENCE (ID(1),IDAT(1,1)),(KEY(1),IDAT(1,2)),( IHR (1),IDAT(1,3)) 
1, ( MINI 1 ) , I0AT( 1,4 ) ) , ( IDAY( 1 ) , I DAT( 1,5) ) , I IYR( 1 ) , IDATI 1,6 ) ) , ( IRAH ( 1 
2 ) , I DAT (1,7)),( I RAMI 1 ), ID AT (1,8) ),(I SGND ( 1 ),IDAT(l,9) ) , ( IDECD ( 1 ) , ID 
3AT(1,10) ),(IDECM(1 ), IDATI 1,11)) 

DIMENSION SEC (50) ,RAS( 50 ) ,DECS ( 50) ,VAR RA( 50 ) ,VARDEC( 50) , COVR AD ( 50) 
1 , DAT ( 5 0, 6 ) 

EOU IVALENCE ( SECI 1 ) .DAT (1,1)), (RAS (1),DAT(1,2)),(DECS( 1) ,DAT( 1,3)) , 
1 ( VARRA (1),DAT(1,4)),( VARDEC ( 1) , DAT (1,5)), (COVR AO ( 1),DAT(1,6) ) 
DIMENS ION DN(3 ,3 , 150 ) , BN( 3. 3 ,50 ) ,DDN (3 , 3 ) ,DK (3 , 150 ) , DDK( 3 ) , A (2 ,3 ) , 
1W( 2 ,2) »DL ( 2 ) 

DIMENSION PM(3,3) , AP ( 2 , 3 ) 

DIMENSION Ll(3) , L2 (3) ,TA( 3) 

COMMON /WPW/HPH ,XPU , I DEGF , NFSTA 
DIMENSION NOBSTAI 150) 

REAL*4 VPVSTAI 150) 

MAXSTE=50 
SPR=206264.80625D0 
PI =3. 1415 92653 58D0 
PI2=2.0*PI 
RP0=180.0/PI 
WPHSPsO.O 
C 

REWIND 2 
REWIND 3 
READ! 3 ) TO 
WRITE! 6,6004) TD 

6004 FORMAT (//20X, 'TEST DISTANCE =»,F20.2,» SECONDS OF ARC') 

START DATA INPUT 
DO 70 KSTA=1 ,NSTA 
NOBSTAI KSTA)=0 
VPVSTAI KSTA) =0.0 
DO 70 1=1,3 
DK( I,KSTA)=0.0 
DO 70 J=1 , 3 
DNC I, J, KSTA) =0.0 
70 CONTINUE 
KEVENT=0 
EPR=0. 0 
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210 CONTINUE 

REAP (3) IEVENT,NSTE,GAST,PM,EPR, 

1(!IDAT(IS,J),J=1,11),M0NTH(1S),(DAT( IS , J 1 ,J=1, 6) , ALFS! IS ) ,DECC I S) , 
2KSTATEC IS) , IS=1,NSTE ) ,CONTIN 
DO 270 IS=1,NSTE 
KSTA=KSTATE( IS) 

CALL DGMPRD (PM ,STAUVW (1 »KSTA) » STAXYZ ( 1 , IS) ,3,3,1) 

270 CONTINUE 

WRITE! 6,6008) IEVENT 
6008 FORMAT!/ IX, ‘EVENT*, 16) 

C 

CALL DEO IT 
C 

DO 280 IS=1 , NSTE 

280 WRITE! 6,6010) I D ( I S ) , KEY < I S ) , I HR! I S ) ,M IN ! I S) ,S EC 1 1 S) , I DAY I IS ) , 
IMONTH! IS) , IYR (IS) , IRAH ( IS ) , I RAM { IS ) ,RAS ( I S) , ISGNDt I S ) , IDECD! IS), 
2IDECM! IS) .DECS! IS) ,VARRA< IS) ,VARDEC( IS ) ,COVRAD! IS) ,D( IS) , 

3DELC0D ( IP ASS! IS) ) 

6010 FORMAT (I7,A1,2I3,F9.5,3X«I3,A3,I2,2I3,F8.4,3X,A1,I2,I3,F8.4, 
15X,3F6.2,F10.1,2X,A1) 

C 

1F( ECODE.GT . 1 ) GO TO 630 
IF! PCODE (11)) 610,630,610 

610 IF (PCODE! 11 )— 3) 611,612,611 

611 WRITE! 6,6024) S 

6024 FORMAT!* SATELLITE POS IT ION • ,3F 15 .3 ) 

IF! PCODE ( 11 )— 2 ) 612,630,612 

612 IDTS=IDS(KSTATE(1) ) 

CALL UVWTG2 (S,DATPRM! 1, ID TS ) ,PHI, FLAM , H) 

PHI=PHI*RPD 

FLAM=FLAM*RPD 

WRITE! 6,6023) PHI ,FLAM,H 

6023 FORMAT! • GEOD. COORD. OF SATELLITE • ,2F1 4.6, F14. I ) 

630 CONTINUE 

WRITE! 6,6012) GQI 
6012 FORMAT ( 10X , ' GQI = * , F10 .5 ) 

IF! ECODE.GT. 1) GO TO 290 
IF(NSUSED.EQ.O) GO TO 290 
RMSMC=DSQRT ( EVSUM/DFLOAT ( NSU SED ) > 

WRITE (6,6011 ) RMSMC 

6011 FORMAT (1H+,27X, 'RMS MISCLOSURE IN METERS=' »F10.1) 

GO TO 300 

290 WRITE! 6,6015) ECODE 

6015 FORMAT ( 1H+.27X, ' ENTIRE EVENT DELETED, K0DE=*,I4J 
GO TO 600 

SET UP OBSERVATION EQUATIONS FOR THIS EVENT AND COMPUTE CONTR I BUTOONS 
TO THE NORMAL EQUATIONS 
300 CONTINUE 

IF! ECODE. GT.l) GO TO 600 
KEVENT=KEVENT+l 
DO 310 1=1,3 
DDK! I) =0.0 
DO 310 J=1 ,3 
DON! I » J)=0.0 
310 CONTINUE 
C 

JS=0 
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DO 390 IS=1 »NSTE 

IF ( IPASSI ISI.GT.l) GO TO 390 

JS=JS+1 

C JS IS THE COUNTER FOR NON-DELETED STATIONS IN THE EVENT 

RSQCSD=SDC ( 1 , 1 S > **2+SDC( 2 « I S ) **2 
RSQ=RSQCSD+SDC(3,IS)**2 
RCO-DSQRT(RSQCSD) 

ASC-DATAN2 ( SDC( 2» IS) ,SDC ( I. I S) ) +GAST 
DSC=DATAN(SDC (3, ISJ/RCD) 

DL( 1)=ALFS( IS)— ASC 
IF<DL(1).GT.PI) DL ( 1 ) =DL { 1 ) — P 1 2 
1F(DL(1).LT.(— PI)) DLU)=DL(1)+P12 
DL(2)=DEC( IS)— DSC 
C 

COMPUTE WEIGHTS 

VARRA f IS ) = ( VARRA ( I S ) /SPR ) **2 
VARRA( IS) =VARRA( IS )*RSO/RSOCSD 
VARDEC ( I S ) = ( VARDEC < I S ) /SPR ) **2 
C0VRA0(IS)=C0VRAD(IS)/SPR**2 
DET=VARRA( IS)*VARDEC( IS ) -COVRAD ( I S)**2 
W(1,1)*VAR0ECI ISI/DET 
W(2»2)=VARRA( IS)/DET 
W(1,2)=-C0VRAD(IS)/DET 
W(2,1)=W(1,2) 

C 

COMPUTE OBSERVATION EQUATIONS 
A( 1 ,1 ) =— SDC( 2« IS ) /RSQCSD 
A < 1 ,2 ) =+SDC C 1 , I S )/RSQCSD 
A(l,3)=0.0 

FACT0R=SDC(3» IS) /( RSQ*RCO ) 

A( 2 ,1) =— SDC t 1 , IS ) *F ACTOR 
A ( 2 1 2 ) =— SDC( 2, I S )* FAC TOR 
RANGE=OSQRT ( RSQ) 

A ( 2 >3 ) =RCD/RSQ 

CALL DGMPRDl A,PM»A p,2 ,3,3 ) 

6017 FORMAT ( IX, 7D17.9 ) 

C 

K ST A=K STATE (IS) 

ELIMINATE DELETED STATIONS FROM THE LIST OF STATIONS INVOLVED IN 
THE EVENT. 

KST ATE ( JS) =KSTATE( IS) 

C 

COMPUTE VPV OF HISCLOSURES 
VPVT0=0.0 
00 315 11*1,2 
DO 315 JJ=l,2 

315 VPVTO=OL( 1 1 ) *Wt 1 1 , JJ ) *0L < JJ ) ♦VPVTO 
NOB STA ( K STA ) =NOB STA ( KSTA ) *2 
VPVSTA IKSTA ) =VPVSTA( KSTA ) ♦VPVTO 
COMPUTE CONTRIBUTION TO NORMALS 
DO 330 1=1,3 
DO 325 J=l,3 
tERM=0.0 
DO 320 11=1,2 
DO 320 JJ=1 ,2 

320 TERM=TERM+AP(II,I)*W( 1I,JJ)*AP< JJ,J) 

BN( I, J , JS)=— TERM 

ON ( I , J ,KSTA ) =DN ( I , J, KSTA ) ♦TERM 
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DDN ( I , J) =DDN ( I * J ) +TERM 
325 CONTINUE 
C 

TERM=0.0 
DO 328 11=1,2 
00 328 JJ=1,2 

3 28 TERM=TERM-*-A P (I I , I ) *W (I I , J J ) *Dl ( J J ) 

DM I,KSTA)=DK( I, KSTA)— TERM 
ODM I) =DDK( I )*TERM 
330 CONTINUE 
C 

390 CONTINUE 
C INVERT DDN 
0ET=1.0 

CALL 0MINV(00N,3,0ET,L1,L2) 

CALL DGMPRDIDDKfDDNtTA, 1,3,3) 

CALL DGMPRD (TA, DDK, TB, 1,3,1) 

WPWSP=WPWSP+TB 

NSUSED=JS 

WRITE! 2) NSUSED, DON, DDK, ( ( (BN! I , J , JS) , I=1,3),J=1,3),KSTATE(JS) , 

1 JS=1,NSUSED ) »CONTIN 
600 CONTINUE 
C 

C TEST FOR END OF INPUT 

IF ( CONTIN.EO .ENDS IG) GO TO 700 
GO TO 210 
C 
C 
C 

700 CONTINUE 
C 

CHECK TO SEE IF END SIGNAL HAS SEEN WRITTEN ON DATA SET FT 02 
IF(ECODE.EQ.l) GO TO 710 
BACKSPACE 2 

C READ AND REWRITE LAST RECORD FROM LAST GOOD EVENT 

READ (2) NSUSED , DDN, DDK, ( ( ( BN ( I , J , JS ) , 1=1 ,3) »J=1,3)»KSTATE (JS) , 
1JS=1, NSUSED) 

BACKSPACE 2 

WRITE! 2) NSUSED, DDN, DDK, ( ( ( BN! I , J , JS ) , 1=1,3) , J=1 ,3 ) ,KSTATE ( JS) , 
lJS=i, NSUSED) ,CONTIN 
710 CONTINUE 

WRITE! 2) ((( ON! I »J,KSTA) , 1=1 ,3) ,DK( J,KST A) » J=1 ,3) , 

XKSTA=1 *NSTA ) 

C WRITE (6,6018) (KORDER (KSTA ) , ( ( DN ( I,J,KSTA) , J=l, 3) , 1=1 ,3) , 

C 1KSTA=1 ,NSTA ) 

6018 FORMAT! ( 15/3(3018.7/) ) ) 

WPW=0.0 

N08S=0 

WR I TE ( 6,6019 ) 

6019 F0RMAT(1H1,8(/),10X, 'ANALYSIS OF MISCLOSURES BY STATION*// 

1T10, •STATION', T20, ’NUMBER OF OBSERVATIONS * ,T50, 'RMS MISCLOSURE* ) 

DO 750 KSTA=1 »NSTA 
NOB S=NOB S+-NOB STA! K STA ) 

WPW=WPW-»-VPVSTA(KSTA) 

RMSMC=0. 0 

IF(NOBSTA(KSTA) .GT.O) RMSMC=DSQRT ( VPVSTA (KSTA) /D FLOAT (NOB STA (KSTA) 
1) ) 

WRITE! 6,6020) KOROER (KSTA ) ,NOBSTA( KSTA ), RMSMC 
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6020 F0RMATIT10, I7,T35,I7,T50 f F14.2J 
750 CONTINUE 

IDEGF=NOBS— 3*KEVENT 
RM$MC=DSQRT< WPM/DFLOATI IOEGF) ) 

MR I TE( 6» 6021 ) NOBS ,KEVENT » IOEGF ,WPW, RMSMC 

6021 FORMAT (////10X» •TOTAL NUMBER OF GOOD OBSERVATIONS* ,T60, 18// 

110X, 'TOTAL NUMBER OF GOOD EVENTS* ,T60, 18 ,// 

210X, ‘CORRESPONDING DEGREES OF FREEDOM* ,T60t 18// 

310X, 'TOTAL SUM OF SOUARES OF MISCLOSURES • , T60, F11.2// 

410X, 'CORRESPONDING STANDARD DEVIATION OF UNIT WEIGHT* ,T60, FI 1.2) 
WPW=WPW-WPMSP 
MRI TE( 6*6022 ) WPW 

6022 FORMAT (1H0.9X,* WPW INCLUDING CONTRIBUTION FROM SATELLITE POSITION* 
1/15X, MI.E.t VPV+UX) ST60.F11.2) 

RETlRN 

END 
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SUBROUTINE EXPAND (XPO,YPO,ZPO,CNM,SNM,LCT,ICT,UMT,VMT,CTB,CTT 
1,ERD,XMU, ALF,OMG,ECC,NT£,KTR,KDR,NHT,CDC,CTW,KEY,DMT,KRG»CMC) 
IMPLICIT REAL*8(A-H,0-Z) 

DIMENSION LT(5),KT(5) 

DIMENSION XPO(l>,YPO(l),ZPO(l),CNM(l),SNM(l) 

It LCT ( 1 ) , ICT( 1 ) tUMT( 1 ) t VMTI 1)»CTB(1),CTT(1) 

DIMENSION DMT ( 1 ) 

DIMENSION CMC (3) 

COMMON INTERNAL WORKING ARRAYS 
DIMENSION 

1 XTL(8) tCLB ( 8) ,CLT { 8 ) ,RPT ( 8 ) ,RMO( 8 ) ,RZR C 8 ) tVRB 18 ) t 

2 YTL(8) ,SLB(8) ,SLT(8) ,RMT(8) ,RMR(8) 

COMMON /ORBCOM/ 

1C SO (8) ,SSQ( 8) y SCSI 8) , BXB( 8 > . BYB (8 ) ,BZB (8 ) , XVR( 8) ,YVR (8 ) * ZVR( 8) t 
2 QAV(8),QBV(8),QCV(8),AMT(72),FEE(72),CGB(8),SGB(8> 

EQUIVALENCE 

1 ( CLB ( 1 ) yCSQ ( 1» ) , (CLT(l) ,XVR(1) )» CRPTC1) tBXBU)) »(RZR(II tQAVCl) ) 

2 y (SLB( i)ySSQ(i)) y(SLT(l) »YVR(1)I , (RMT(l) ,BYB(1) > , ( RMR ( 1 ) »QBV(1 ) ) 
3,{XTL(1),SCS(1) ) , (YTL(l) ,ZVR(1) ), (RMO(l) ,BZB(1) ) t (VRB(l) ,QCV(1) ) 

COMMON DATA BLOCK END 

EQUIVALENCE ( LA,LT( 1 ) > , ( LB ,LT(2 ) ) , (LC, LT ( 3) > , ( K,LT (4 ) ) , ( L ,LT(5) » 
EQUIVALENCE I KA»KT( I ) » , ( KB ,KT( 2 )) » (KC yKT( 3) ) » ( M ,KT ( A ) ) , (N , KT (5 ) ) 
C 

CGB( 1 )=DCOS (ALF) 

SGB(l) =DSI N ( ALF ) 

CLB m =XPO I 1 ) *CGB (1) +YPO (1» *SGB m 
SLB(l»=YPO(lI*CGBm-XPOIl)*SGBm 
rpt < i » *xpo m *xpom +ypo ( u *ypo a ) ♦zpo m *zpom 

RMT (II»l.O/RPT(l) 

RMO (I) =DSQRT ( RMT II) J 
CLT ( 1 ) =ERD*RMT ( 1)*CLB( 1 I 
SLT ( 1 ) sERO*RMT ( 1 >*SL8( 1 ) 

RZR III =ERD*RMT I 1 I *ZP0II ) 

RMR (1) =ERD*ERD*RMT(1J 

DRX=0.0 

DRY=0.0 

DRZ=0.0 

NG = 0 

I TR=3 

KA= 1 

IF (KEY-2) 10 » 10, 490 

COMPUTE CTBtCTT ARRAYS TO MATCH TABLE ALLOCATION 
10 CONTINUE 

COMPUTATION OF CTB AND CTT ARRAYS MOVED TO DATA STATEMENT IN ORBIT 
GO TO (60, 150), KEY 

COMPUTE ICT TABLE ENTRIES AND TOTAL ARRAY LENGTH 
60 CONTINUE 
KEY=3 
NET=1 
KTR=10 
LNTH=1 
LA=LCT(2) 

LB=LCT ( 1 ) 

LC = LA 
NA=NTE+1 
DO 130 1=1, NA 
KA=LA— 1 
KB = LB 
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KC=LC*1 

IF (KB-KA) 70,80,80 
70 KB=KA 

80 IF (LC) 110,110,90 
90 IF (KB-KC) 100,110,110 
100 KB=KC 

110 LNTH=LNTH+KB-*'l 
ICT C I ) =LMTH 
LA=LB 
LB=LC 

LC=ICT( I + 2> 

IF (I-NTE) 130,120,120 
120 LC=0 
130 CONTINUE 

LNTH=LNTH— 1 
KA=1 

GO TO 490 
150 CONTINUE 
KEY =3 
NET=2 
LNTH=1 

DO 160 1=1,3 
160 LT ( 1*2 )=LCT( I ) 

IF CNTE— 2 1 170 , 180 , 190 
170 K=0 
180 L=0 
190 LB=K 
LA=L 

NA=NTE*2 
DO 280 J=l,NA 
DO 210 1=1,5 
KT ( I J =0 

IF €LT C I > 1210,210,200 
200 KT( I)=LT< 1 * ♦ I — 2 
210 CONTINUE 
KK=0 

DO 230 1=1,5 

IF (KK-KTII) 1220,230,230 
220 KK=KT( I ) 

230 CONTINUE 

LNTH=LNTH+KK*1 
ICT ( J I =LNTH 
DO 260 1=1,4 
260 LT( I )=LT ( 1*1 ) 

L=LCTU*3) 

N=J-NTE+2 
IF (N) 280,270,270 
270 L=0 
280 CONTINUE 

LNTH=LNTH— 1 
KA=1 

GO TO 490 

C BEGIN THE ITERATIVE INTEGRATION FOR THE SOLUTION. 

C 300 SERIES - COMPUTE X,Y,Z COEFFICIENTS 
300 KA=1*( ITR-3)*LNTH 
KB= 1 
TMA=0.0 
TMB=0.0 
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TMC 

=0.0 


TMD 

= 0.5 


KG 

= 0 


NA 

= I C T ( 1 ) — 2 


NB 

= 1 


NC 

= NA+2 


00 

380 I=1,NTE 


KC 

= LCT(I) 


IF 

(KC I 380, 380 *310 

310 

IF 

(1-2)330,315,320 

315 

NA 

= 1 


GO 

TO 325 

320 

NA 

= 1CTU-2) 

325 

NB 

= ICT( 1-1) 


NC 

= ICT(I> 

330 

LA 

= KA+NA+1 


LB 

= KA+NB 


LC 

= KA+NC-1 


DO 

375 J = 1 ,KC 



TME 

= 

CTB(KB) 


TMF 

= 

TME 


IF I 

1 KG >345,345 ,350 

365 

TMF 

= 

TMD^TME 


TME 

= 

-TMF 


TMI 

s 

J 


TMJ 

= 

J+2 


TMD 

s 

TMD*TMI /TMJ 

350 

TME 

a 

TME*UMT(LA> 


TMF 

s 

TMF*VMT ( LA) 


TMG 

= 

UMT(LC) 


TMH 

= 

VMT(LC) 


TMI 

= 

CNM(KB) 


TMJ 

= 

SNM(KB) 


TMK 

= 

TME— TMG 


TML 

= 

TMF+TMH 


TMM 

= 

TMF— TMH 


TMN 

= 

TME+TMG 


TMO 

= 

UMT(LB) 


TMP 

as 

VMT(LB) 


IF 

(KRG) 370,370,365 


365 DMT(NG*1) = TMK 
0MT(NG*2) = TML 
DMT (NG+3 ) = TMO 
DMT (NG+4) = TMM 
DMT (NG+5 ) = TMN 
DMT(NG+6) = TMP 
NG = NG+6 

370 TMA = TMA*TMI*TMM-TMJ*TMM 
TMB = TMB-TMI*TML+TMJ*TMN 
TMC = TMC+CTT ( KB l*(TMI*TMO*TMJ*TMP ) 
LA = LA+1 
LB = LB+1 
LC = LC+1 
KB = KB-*-l 
375 CONTINUE 
380 KG = 1 

TMO = 0.5/ERD 
KK= ITR— 2 


- 100 - 



XTL IKK )=TMA*TMO 
YTL (KK ) =TMB*TMD 
TMC=TMC*TMD 
TMD=KK*(KK+1) 

KA=KK 
TMA=ORX 
TMB=ORY 
TMC=TMODRZ 
00 390 1=1, KK 
TME=CGB( I ) 

TMF=SGB(I) 

TMG=XTLtKA) 

TMH=YTL(KA) 

TMA=TMA-«-TME*TMG~TMF*TMH 
TMB=TMB+TMF*TMG+TME*TMH 
390 KA=KA— 1 

TMA=TMA-0MG*0MG*(CMC ( 1 ) *CGB ( KK l-CMC ( 2) *SGB{ KK) ) 

TMB =TMB-0MG*0MG* ( C MC ( 1 ) *SGB ( KK ) ♦CMC (2)*CG8(KK) ) 

XP0(ITR)=TMA/TMD 

YPO ( ITR) =TMB/TMD 

ZP0C1TR)=TMC/TMD 

ITR=ITR+1 

IF (KTR— I TR)400,410,410 
400 RETURN 

C 400 SERIES - COMPUTE EXTENSION DERIVATIVES 
410 TMO=KK 
KA=KK>1 

CGB(KA)=-OMG*SGB(KK)/TMD 

SGB (KA )= OMG*CGB(KK)/TMO 

KK=KA 

KB=KK 

TMA=0.0 

TMB =0.0 

TMC=0.0 

DO 420 1=1, KK 

TME=XPO( KB) 

TMF=YPO( KB) 

TMG=CGB( I ) 

TMH=SGB( I ) 

TMA=TMA^TME*TMG*TMF*TMH 

TMB=TMB+TMF*TMG-TME*TMH 

TMC=TMC+TME*XPO ( I )+TMF*YPO( I I+ZPOCKB )*ZPOI I ) 

420 KB=KB— 1 

CLB CKA ) =TMA 

SLB (KA)=TMB 

RPT (KA )=TMC 

KB=KK— 1 

RMT (KA )=0.0 

TMA=0.0 

DO 430 1=2, KK 

TMA=TMA— RHT(KB) *RPT( I ) 

430 KB=KB— 1 

RMT (KA ) =RMT( 1 )*TMA 

KB=KK-1 

TMA=RMT( KA) 

KC=KB 

IF (KC— 1 ) 460 ,460 ,440 
440 DO 450 1=2, KC 
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THA=TMA— RMQ(KB) *RMO{ I ) 

450 XB=KB-1 

460 RMO(KA ) =TMA/ ( 2 .0*RMQ( 1) ) 

K8=KK 

TMA=0.0 

TMB=0.0 

TMC=0#0 

DO 470 1=1 »KK 

TMI=RMT(KB) 

THA=TNA+TM I*CLB ( I ) 

TMB=TMB+TMI*SLB(I) 

TMC=TMC+TMI*ZPO(I) 

470 K8=KB— 1 

CLT(KA)=TMA*ERD 
SLT(KAI=TMB*ERD 
R MR ( KA I =RMT ( KA I *ERD* ERD 
RZR (KA)=TMC*ERD 

C 500 SERIES - COMPUTE U,V ARRAY EXTENSION COEFFICIENTS 
490 CONTINUE 

NA=LNTH*( ITR-3I+1 
UMT(NA)=XMU*RMO(KA) 

VMT(NA)=0.0 
LA= 1 
LB = 1 
KB=2 

NB=NTE+NET 
DO 580 1=1 ,NB 
KC=ICT ( I )— 1 
M = I-1 
N=M 

IF IKC-KB 1550, 500, 500 
500 KK=2 

DO 540 J=KB »KC -= — 

LC=LB 
NC=KA 
TMA=0.0 
TMB=0. 0 
TMC =0.0 
TMD=0. 0 
TME=N+N*i 
TMF=N+M 
TMG=N-M+1 
DO 530 K=1 » K A 
GO TO (510, 520), KK 
510 TMI=RMR(NC) 

TMC=TMC*TMI*UMT( LC-1 ) 

TMD =TM D+TM I *VMT ( LC- 1 ) 

520 TMJ=RZR(NC) 

TMA=TMA*TMJ*UMT ( LC ) 

TMB=TMB*TMJ*VMT( LC ) 

NC=NC— 1 
530 LC=LC+LNTH 
NA=NA+ 1 

UMT (NA ) = ( TME*TMA— TMF*TMC ) /TNG 
VMT (NA ) =( TME*TMB— TMF*TMD) /TMG 
LB=LB+1 
N=N*1 
540 KK=1 
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550 IF (1-NB)560, 580,580 
560 NA=NA«-1 
TMC=2*M+1 
NC=KA 
THA=0,0 
TMB=0.0 
00 570 K=I,KA 
TMG=CLT(NC) 

TMH=SLT(NCI 

TMI=UMT(LA) 

TMJ=VHT(LA) 

TMA=TNA*TMG*TNI— THH*TMJ 
TMB=TMB-*TMG*TMJ+TMH*TNI 
LA=LA+LNTH 
570 NC=NC-l 

UMT(NA»=TMA*TMC 

VMT(NA)=TMB*TMC 

KB=KC*2 

LB=LB*1 

LA=LB 

580 CONTINUE 

IF (KOR) 300,300,600 
COOING FOR DRAG COMPUTATIONS ARE OMITEO 
600 GO TO 300 


o o o o o o o 


SUBROUTINE VAR IEQ( XPQ,YPO,ZPO »CNM, SNM»LCT » ICT»UMT »VMT ,UVM, ERD,ALF, 
*OMG »CDC»CTW»NTE,KTR»KDR) 

IMPLICITREAL*8(A-H,0-Z) 

01 MENS IONTMT (9) 

DIMENS I ONXPOU) ,YP0d>,ZP0d ),CNMd) ,SNH(I) ,LCT(1) y ICT< I),UMT(1), 
*VMTdJ ,UVM( I ) 

COMMON INTERNAL WORKING ARRAYS 

DIMENSION XTL ( 8),CLB( 8>,CLT{ 8»,RPT< 8>,RM0< 8),RZR( 8),VRB< 8), 
* YTL( 8 ) » SLB ( 8) *SLT( 8),RMT{ 8),RMR( 8» 

COMMON /ORBCOM/CSQ ( 8),SSQ< 8), SCSI 8),BXB( 8),BYB< 8),BZB( 8), 

1 XVR ( 8 ) » YVR C 8) , ZVR( 8),QAV( 8),QBV< 8),QCV< 8)» 

2 AMTC 72),FEE( 72),CGB< 8>,SGB! 8) 

EQUIVALENCE ICLBd) ,CSQd) ) , ICLT d> ,XVR d) ) , IRPTd) »BXB( I) ) » tRZRd 
*) ,QAV( 1) ) , (SLB<1) ,SSQ(in ,ISLT( 1) ,YVRd> > , IRMTd ) ,BYBd>) , (RMRd) , 
*QBVd>),(XTLd>,SCSd)>,(YTLd>,ZVRd)>,(RMOd),BZBd>),(VRBd),QC 
*V (1 ) ) 

COMMON DATA BLOCK END 

EQUIVALENCE dMTd),THA),(TMT(2) »TMB) ,( TMT(3) tTMC) 

EQUIVALENCE (TMT( 4) ,TMDI , I TMT ( 5 ) ,TME) , ( TMTC6) ,TMF ) 
EQUIVALENCECTMT(7) ,TMG) , I TMT{ 8) ,TMH) , ( TMTI9) ,TMI> 

INITIALIZE ALL OF THE EXTERNAL ARRAYS. 

CALLCLEARITMT ,9) 

I F( KTR— 2 ) 90,90,20 
20 KA=KTR— 2 
D040KC=1,KA 
KB=KC 

D030I* lyKC 
AU-CGB (KB ) 

BU-SGB (I) 

TMA=TM A+CGB (I) *AU 
TMB=TMB+BU*SGB IKB ) 

TMC=TMC+BU*AU 
30 KB=KB— I 

CSQ (KC ) =TMA 

SSQ (KC )=TMB r 

SCS(KC)=TMC 
TMA=0.0 
TMB=0.0 
TMC=0.0 
40 CONTINUE 
RDS=ERD*ERD 
LNC=ICT(NTE+2)-i 
I TR=2 

L=9 *KTR— 18 
CALLCLEAR ( AMT ,L) 

KOG=KDR— 2 

DRAG COMPUTATIONS DELETED. INITIALIZATION OF HNV AND VRN DELETED. 

TEST FOR PROCESS COMPLETE - BEGIN THE ITERATIVE LOOP 

80 ITR=ITR*1 

IF (KTR— ITR 190,100,100 
90 RETURN 
100 K A= ITR— 3 
I = H-KA*LNC 
LA=I*ICT( 2)— 1 
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LB= I+ICT ( 1 ) 

LC=I*2 

LO=LB 

LE=LA 

M-0 

KB=i 

TMQ=0.0 

TMR=1. 0/24.0 

TMS=1. 0/6.0 

ICT2=ICT(2) 

D0270I=1,NTE 

N=M 

KC=LCT ( I ) 

1F(KC) 210*210*120 
120 CONTINUE 

D0200J=1,KC 

L=N-H+2 

CZZ=L*<L-1> 

CPZ=L*(L*1> 

CPM=|L+1)*(L*2> 

AU=UMT (LAI 
BU=UMT ( LB I 
CU=UHT(LC» 

DU=UMT(LD) 

EU=UMTCLE» 

AV=VHT (LA) 

BV=VMT(LB» 

CV=VMT«LC) 

OV-VMT(LD) 

EV=VMT (LEI 
CC=CNM(KB) 

SC=SNM(KB> 

TM I=TM I+CZZ* I CC*CU*SC*CV ) 

IF C M— 1 ) 140* 160* 180 
140 AU=AU*TMR 
BU=-BU*TMS 
AV=-AV*TMR 
BV=BV*THS 
TMQ=TH Q+1.0 
TMR=TNR*TMQ/( TNQ+4.0) 

TMS=TMS*<TMQ+1.0»/CTMQ+3.0) 

GOT 0180 
160 AU=-AU*TMS 
AV=AV*TMS 
TMQ=TMQ+1 .0 
TMS=TMS*TMQ/< TMQ+2 .0 J 
180 T=L-1 

TMA=TMA+CC*( EU*CZZ*( CPM*AU— CU-CU) >*SC* IEV+CZZ* <CPH*AV-CV-CV) ) 
TMB=TMB+CC*IEV-CZZ*CPM*AV)*SC*(CZZ*CPM* AU-EU ) 
TMC=THC-T*(CC*CCPZ*BU-DU)+SC6(CPZ*BV-0V)> 
TMF=TMF+T*tCC*(CPZ*BV+OV>-SC’MCPZ*BU-K>UJ) 

KB=KB*1 
LA=LA*1 
LBsLB+1 
LC=LC*1 
LD=LO-*-l 
LE=LE*1 
200 N=N+1 
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210 L=KA*LNC 

I F ( M— 1 ) 220 t 230»240 
220 TMQ=2.0 

TMS=1. 0/12.0 
LA=L+ICT2+2 
LB=L*-4 
G0TC260 
230 LA=L*5 
G0TO250 

240 LA=L*4*ICT< 1-1) 

250 LB=l>3-*-ICT( 1 ) 

260 LC=L*2+ICT( I+1J 
LD=L*H-ICT( 1+2) 

LE=L*ICT( I ♦3 J 
270 M=M+1 

TMR=2.0*R0S 

TMC=TMC/TMR 

TMF=TMF/TMR 

TMR=2.0*TMR 

TMA=TMA/TMR 

TMB=TMB/TMR 

TMD=TMB 

TMG=TMC 

TMH=TMF 

TMI=TMI/RDS 

TME=— TMA— TNI 

L=9*KA*1 

002801=1,9 

FEE ( L ) =TMT( I ) 

280 L=L+1 

CALLCLEARCTMT,9) 

EVALUATE THE K-TH TERM OF THE MATRIX A<3,3) 

DRAG COMPUTATIONS DELETED. 

500 L=0 

KB=KA*1 

N=KB 

D05 101=1, KB 
AU=FEE(L+1) 

BU=FEEIL*2> 

CU=FEEIL*3> 

DU=FEE(L*5> 

EU=FEE(L*6) 

AV=CSQ (N) 

BV=SSQ(N) 

CV=SCSCN) 

OV=CGB(N) 

EV=SGB(N> 

TMA=TMA+AU*AV-2.0*BU*CV+DU*BV 
TMB=TMB+CV* ( AU-OU ) +BU*< A V-BV ) 
TMC=TMC«-CU*OV -EU *E V 
TMF=TMF+CU*EV+EU*DV 
N=N-1 
510 L = L+9 

L=9*KA*9 
TMI =FEEC L ) 

TMD=TMB 
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TME=— TMA— TMI 
TMG=TMC 
TMH=TMF 
L=L— 8 

005201=1,9 
AMT(U=AMT<LI*TMT<IJ 
520 L=L*1 

CALLCLEAR(TMT ,9) 

EVALUATE U AND V MATRICES FOR IK+2JTH TERM IN SERIES 

KB=KA*1 
TMQ=KB*( K8+1 ) 

TMQ=1.0/TMQ 
TMR=1 .0 
KC= 18*KA-2 
D0600LA=1 ,2 
LB=KC*39 
LC=0 

D0580LD=1 ,KB 
LE=1 

00570J=1,3 
I=3*J*KC 
AU=UVM ( I ) 

BU=UVM ( I +1 ) 

CU=UVMII+2) 

C DRAG COMPUTATIONS DELETED. 

D0570M=1 , 3 
I=LC*M 

TMS=AMTC I »*AU+AMTI 1+3 ) *BU+AMT{ I +6 ) *CU 
C DRAG COMPUTATIONS DELETED. 

560 TMT(LE)=TMT(LE)*TMS 
570 LE=LE*1 
KC=KC— 18 
TMR=TMR*1.0 
580 LC=LC*9 

D0590I =1 , 9 

UVM (LB ) =TMQ*TMTC I ) 

590 LB=LB* 1 

CALLCLEAR(TMT»9) 

TMR=1 .0 

600 KC=18*KA^7 
G0T080 
END 
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SUBROUTINE ORBIN 
IMPLICIT REAL*8(A— H»0— Z) 

DIMENSION EMODELI 10,2 ) 

DIMENSION XIN(6),0RBEL!6) , R0(3) ,V0(3 ) , 0RBNAMI6 ) , ORBUNKC 16 » , S(3,3) 
EQUIVALENCE ( ORBEL ( 1 > ,ORBA ) , (0RBELI2 I ,ORBECC I * (ORBEL (3) ,ORBI NC) » 

I (OR BEL 14) ,RANOOE) , (ORBEL! 5), ARGPGEI , CORBEL (6 ) , OR BM ) 

EQUIVALENCE { XIN( I ) ,R0!1) ) , ( XIN (4) ,V0( 1) ) , (THEDOT, OMGI ) 

INTEGER*2 LFLG!40> ,KSTAT0!15) , MODEL! 10»2 ) 

INTEGER*2 GUIDE! 10,2 ) , IDAY, I YR 

INTEGER*4 ENDS IG/1HE/*C0NTIN,BLANK/1H ✓ , ALFA/1HA/, ALFR/1HR/, ZCODE 
DATA MAX STQ/15/, MAXSTA/40/»MAXEMU/l0/ 

INTEGER*2 PC0DE(20I 

COMMIT /PCODES/PCODE 

COMMON/OBSD/OBSD! 150) ,OVOBSO 

COMMON /ERDC ON/ERDI, XMUI tOMGI »XCM,YCM f ZCM 

COMMON/NSTA/NSTA 

COMMON /STAORD/KORDER! 150) 

INTEGER STANAM,IDS*2 

C0MM0N/STAL0C/STAUVWI3 * 150) .DATDUM (6,15) ,STANAM( 5,150) , IDS (150) 

DIMENSION CM(3 ) 

EQU IVALENCE ( CM ( 1 ) , XCM ) 

C READ EARTH CONSTANTS 

READ! 5 * 1065 ) EROI ,XMUI ,OMGI ,OVOBSD 
1065 FORMAT (4020. 8) 

C READ THE COORDINATES OF THE CENTER OF MASS IN THE COORDINATE SYSTEM IN WHICH 
C THE STATION COORDINATES ARE GIVEN. 

READ! 5 *1052 ) RO 

C READ UNCERTAINTIES OF CENTER OF MASS 
READ(5,1052) VO 
WRITE (6,1063 ) RO* VO 

1063 FORMAT! /////• COORDINATES OF THE CENTER OF M ASS* ,3F20.3/ 

1 • UNCERTAINTIES *,3F20.3> 

WRITE! 6» 1064) ERDI >XMUI * OMGI 

106A FORMAT (1H1///* EARTH CONSTANTS FOR ORBIT INTEGRATION*/ 

1 T7, 'SEMI-MAJOR AXIS*tT30**GM'»T4fl» 'ROTATION RATE */ 

2 F20.3* 1PD20.10*OPD20. 10 ) 

WRITEI3) ERDI, XMUI, OMGI, RO»VO 

CHANGE THE DATUM ID NUMBER IF RESULTS WILL BE IN AN EARTH CENTERED DATUM 
IF(RO( D.EQ.O) GO TO 135 
IERD=ERDI 
1=0 

132 1=1+1 
IDAT=DATPRM(1,I) 

IF(IDAT.EQ.IERD) GO TO 133 
IF(I.LT.i5) GO TO 132 
WRITE (6,1001) 

1001 F0RMAT(//10X, 'EARTH DIAMETER DOES NOT CORRESPOND TO ANY KNOWN DATU 
1M'//) 

GO TO 135 

133 DO 134 J=1 , 150 

134 IDS! J) =1 

135 CONTINUE 

DO 130 1=1,3 
130 CM ( I )=R0! I ) 

IF(PC0DE!14) . EQ.O) GO TO 140 
DO 139 1=1,3 

139 STAUVW !I,NSTA+i)=RO(I) 

KORDER (NSTA+1 )=0 
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140 CONTINUE 

SPR=206264. 80625 

NOBS=0 

NUNK=0 

DO 160 1=7,16 
160 ORBUNK ( I ) =0 
C READ FIRST CARO 

165 READ(5,1051) NORB,ORBNAM, IOCODE ,C0NT1N 

1051 FORMAT ( A4,6A8 , I 1, 26X, A1 I 

C TEST FOR END OF ALL PASSES 

IF(CONTIN.EQ.ENDSIG) GO T0210 
WRITE (6, 1062) NORB ,ORBNAM 
1062 FORMAT 1 7( / ) » IX, A4*5X ,6A8 ) 

I0C00E=0 MEANS RECTANGULAR ELEMENTS ARE GIVEN IN TRUE SIDEREAL SYSTEM 
IOCODE=1 MEANS RECTANGULAR ELEMENTS ARE GIVEN IN MODIFIED SIDEREAL 
SYSTEM. 

I0C0DE=2 MEANS RECTANGULAR ELEMENTS ARE GIVEN IN EARTH FIXED SYSTEM 
I0C0DE=3 MEANS KEPLERIAN ELEMENTS ARE GIVEN, REFERED TO TRUE EQUINOX. 
I0C0DE=4 MEANS KEPLERIAN ELEMENTS ARE GIVEN, REFERED TO TRUE EQUATOR 
AND 1950 EQUINOX (I.E., THE SOA ORBITAL SYSTEM). 

DO 166 1=1,40 

166 LFLGI I ) =0 

DO 167 1=1,10 
DO 167 J=l,2 
GUIDE! I, J I =00.0 

167 CONTINUE 
NUT0RB=6 
NEMUNK=0 

IF( IOCODE. LT.3IG0 TO 170 
READI5 , 1052 ) ORBA, ORBECC ,ORB INC 
READ! 5 , 1052 ) RANODE, ARGPGE.ORBM 

1052 FORMAT (3D15.8) 

WR I TE( 6, 1055 ) ORBEL 

1055 FORMAT I IX, , A= , ,D18.8,* ECC=' ,018.8,*INC = *,D18.8,/ , RA OF NODE**, 

1015.8, *ARG OF PERIGEE*' ,015.8, *MEAN ANOMALY** ,015.8) 

CALL KEPTCEI ORBEL, XIN) 

IOCODE* IOCODE— 3 
GO TO 171 

170 READ! 5 , 1052 ) RO.VO 

THERE ARE THREE WAYS THE EPOCH CAN APPEAR, AS JULIAN DAYS IN COLUMNS 
0 THRU 15, AS A DATE IN COLUMNS 16 THRU 35, OR IF A DATE OTHER THAN THAT 
IS TO BE USUED THE DATE OF THE ORBITAL ELIMENTS GIVEN WILL BE IN 
COLUMNS 16 THRU 35 WITH THE DESIRED EPOCH TIME IN COLUMNS 51 THRU 71 
ZCODE COLUMNS 36 TH1U41 MUST HAVE SOMETHING PUNCHED IN IT IN THE LAST CASE 

171 RE AD (5 , 1053) EPOCH, IDAY, MONTH, I YR, IH,M IN ,ESEC, ZCODE, IHR, IMIN ,SEC 

1053 FORMAT (015.8 , 15 ,2X,A3,3 15 ,D10.5»3X,A2»T51 ,215,010.5 ) 

IFC EPOCH. EQ.O) GO TO 175 

ITEM=EPQCH 

TEM=ITEM 

TE=(EPOCH-TEM) *86400 

TEMP=TE/3600.0 

IH=TEMP 

TEM P= { TEM P- I H ) *60 . 0 
MIN=TEMP 

ESEC=( TEMP— MIN)*60.0 
T0=IHR*3600+IMIN*60+SEC 
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TIME=EPOCH 
GO TO 180 

175 TEM=MJD! IOAY, MONTH, IYR) 

TE=IH*3600+MIN*60+ESEC 
T0=IHR*3600*IMIN*60«-SEC 
£POCH=TEM+TE/86400.0 
TIME=TEM+T0/86400.0 
IF(ZCODE.EQ. BLANK) T1ME=EP0CH 
180 CONTINUE 

HR ITE( 6 ,1054) RO, VO, EPOCH 
IF ( IOCODE.NE.l ) GO TO 185 
CALL PRENUT (TIME, PAN) 

CALL R0T3 ( —PAN , RO ) 

CALL R0T3 ( —PAN, VO ) 

185 G A STO=GSTD (TIME) 

CALL PRENUT (TIME, PAN) 

GASTO=GASTO*PAN 

1054 FORMAT! /IX, *X=' ,D18.8,1X, *Y= • ,D18 .8 , IX, • Z=' , D18.8, /IX , *XDOT=', 
1015.8, IX, 'YD0T=',D15.8,1X,'XD0T=',D15.8,/1X, *E P0CH= • ,015 .8 , 1CK , 
2 1 5 , 2X, A3 , 15, /22X ,*GAST=* ,015.8//) 

IF ( IOCOOE .NE.2 ) GO TO 190 
R01=R0!l) 

R02=R0(2) 

CALL R0T3!— GASTO,RO) 

VO! 1 )=V0 1 1 )— THED0T*R01 
VO! 2) =V0! 2 ) +THED0T*R02 
CALL R0T3 l — GASTO , VO) 

190 IF1T0-TE) 195,200,196 

195 IF! ZCODE.EQ. BLANK) GO TO 200 

196 IF !TE.NE.O) GO TO 198 
EP0CH=TIME 

GO TO 200 

198 CALL ORBITIO, TO, TE, GASTO, XIN) 

200 CALL POLE !EPOCH,XPM,YPM) 

XPM=XPM/SPR 

YPM=YPM/SPR 

XP=XPM 

YP=YPM 

G AS T=GSTD! EPOCH) 

CALL PRENUT! EPOCH, PAN) 

GAST=GAST+PAN 
HR I TE ( 6 , 1154 ) 

1154 F0RMAT1/1X, 'VALUES STORED ON UNIT 3') 

WRITE! 6, 1054) RO, VO, EPOCH, IDAY, MONTH, IYR ,GAST 
210 HR I TE ! 3 ) IORB , NOR 8, OR BN AM , EPOCH, IDAY, MONTH, IYR , GAST,RO, VO, TE, 1H, 
1MIN »ESEC»XPM»YPM»CONTIN 
IF! CONTI N.EO .END SI G) RETURN 
NOBSTO=0 
HR I TE ( 6,6005 ) 

6005 FORMAT ( • STATION DATE ', T2 5 ,' T IME 1UT) ' ,3X , »0B SERVED RANGE' ,2X 

1 'UNCERTAINTY') 

C READ OBSERVATION CARD 

220 READ! 5, 1061) ID, IYR , MONTH, IDAY, I H, IMI N, SEC, SEC1 ,RS0,RS01 , VARR A , 
1C0NTIN 

1061 FORMAT! 14X, 14, 51 2 , F2 .0, F4.0, F 16 .0 , F3 .0 , 1 IX , F6. 3 , 9X , A1 ) 

C TEST FOR END OF PASS 

1F!C0NTIN.EQ.ENDSIG) GO TO 240 
KSTA=KSTAID< ID) 
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IF ( CON TIN.EQ. ALFA) GO TO 290 
IFJCONTIN.EQ.ALFR) GO TO 300 
NOBSTO=NOBSTO+1 
N0BS=N0BS+1 

I F I PCODE (12) . EQ . 1 ) VARRA=OBSD( KSTA ) 

I F ( PCODE ! 12 ) .EQ.2 ) VARRA=OVOBSD 
RS0=RS0+RS0l/1000. 0 
IFISEC1.LT.1) GO TO 230 
SEC=SEC*SEC i/10000.0 
GO TO 231 

230 SEC=SEOSECl 

231 CONTINUE 
LFLG!KSTA)=1 

TEMO=MJD! IDAY,MONTH,IYR) 

TOBS=IH*36OO+IMIN*60+SEC*!TEMO-TEM) *86 900.0 
TO=TOBS— TE 

IF(DABS(TO) .GT. 10000) GO TO 260 

GASTO=GAST+TO*THEDOT 

SINST=DSIN(GASTO» 

COSST=DCOS!GASTO) 

FILL IN "S" ARRAY ACCORDING TO SAO SPECIAL REPORT 123, "PRECISE ASPECTS 
OF TERRESTRIAL AND CELESTIAL REFERENCE FRAMES", PAGE 8 
S ( 1 ,1 ) =COSST 
S(2,l) =— SINST 
S ( 3,1 ) =— XP*COSST-YP*S INST 
S( 1,2)=SINST 
S(2,2)=C0SST 

S 1 3 ,2 ) =— XP*S INST+YP*COSST 
S ( 1,3) =XP 
SC 2, 3) =— YP 
S ! 3,3 ) =1 .0 

WRITE! 6, 1056) ID, I DAY ,MONTH, IYR , IH, I MI N,SEC, RSO, VARRA 

1056 FORMAT ! 17, 14, IX, A3, 1 3, 15, 1 3, F8. 4, F13. 2, 2F 15. 2) 

240 WRITE! 3) TOBS , TO, KSTA, GASTO, SINST, COSST, RSO, VARRA, ID, IDAY .MONTH, 

1 IYR,IH»IMIN,SEC,S ,CONT IN 
IF CCONTIN.EQ.ENDSIG) GO TO 270 
60 TO 220 

260 WRITE! 6, 1057) TOBS.TE 

1057 FORMAT 1 IX , 'TIME OF OBSERVAT ION=* ,F20 .10, /IX, 'TIME 0FEP0CH=', 
1F20.10) 

STOP 

270 NSTAT0=0 

DO 280 KSTA=1,NSTA 
IF(LFLG!KSTA) . EQ.O ) GO TO 280 
NSTAT0=NSTAT0+1 

IF! NSTATO.LE.MAXSTO) GO TO 277 
WRITE! 6, 1058) MAXSTO 

1058 FORMAT! IX, 'MORE THAN', 12,' STATIONS OBSERVED') 

STOP 

277 KSTATQ(NSTATO)=KSTA 
LFLGCKSTA) =NSTATO 

280 CONTINUE 

I F( PCODE ! 14) .EQ.O) GO TO 2800 
NSTAT0=NSTAT0*1 
KSTAT0!NSTAT0)=NSTA*1 
2800 CONTINUE 

DO 281 1=1,6 

281 0R8UNK ! I ) =XI N( I ) 
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I F ( NEMUNK .EQ .0) GO TO 285 
00 283 1=1, NEMUNK 

GET THE ORDER # OF THE STATION TO WHICH THIS ERROR MODEL 
TERM PERTAINS 
KST A=MODEL( 1,2) 

ISTA=LFLG(KSTA) 

IF( ISTA.NE.O) GO TO 282 
WRITE!6,1059> KORDER (KSTA ) 

1059 FORMAT C IX, 'ERROR MODEL UNKNOWN FOR STATION ',13,' IS MEANINGLESS 
1SINCE STATION DOES NOT OBSERVE THIS PASS.') 

282 MODCOD=MODEL (1,1) 

GUIDE! ISTA,MODCOD) =1*6 

283 CONTINUE 

285 WRITE! 4) ORBUNK,NSTA TO, LF LG, KSTATO, NEMUNK, EMODEL,MODEL, GUIDE 
1 , NUTORB 

GO TO 165 
290 M0DC0D=1 
60 TO 310 
300 M0DC0D=2 
GO TO 310 

310 NEMUNK =NEMUNK*1 

I F ( NEMUNK. LE.MAXEMU) GO TO 311 
WRITEI6, 1060) MAXEMU 

1060 FORMATUX, 'ERROR-NUMBER OF ERROR MODEL UNKNOWNS EXCEEDS *,I5) 
STOP 

311 NUT0RB=NUT0RB+1 
MODEL ! NEMUNK , 1 ) =M0DC0D 
MODEL! NEMUNK, 2) =KSTA 
EMODEL I NEMUNK , 1 ) =RSO 

E MODEL 1 NEMUNK, 2 )=VARR A 
OR BUNK ! NUTORB ) =RSO 
GO TO 220 
END 
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SUBROUTINE FOAN 
IMPLICIT REAL*8(A-H,0-Z) 

INTEGER42 I0AY,1YR 
INTEGER*4 C0NTIN,ENDSIG/1HE/ 

COMMON/NSTA/NSTA 
INTEGER STANAM, IOS*2 

COMMQN/STALOC/STAUVW(3,150) »OATPRMI2 ,15) , DATNAMI4, 15 ) , 

1STANAM (5,150) ,IDS( 150 ) 

COMMON /STAORD/KORDER ( 150) 

COMMON /WPW/WPW, XPU, IDEGF,NFSTA 
DIMENSION NOBSTA ( 40) 

REAL*4 VPVSTAI40) 

OIMENSION R0(3) ,V0(3) ,XT( 6) ,UVWT (3 ,9 ) , EXT( 3) , EUVWT 13,9) , XSI 3) , 

1 DCS (3) ,S(3,3) 

COMMON /ERDCON/ERDI,XMUI »OMGI ,CM ( 3 ) 

DIMENSION C ( 3) ,CC ( 3) ,D(9) ,0N0( 3,3,40) 

INTEGER*2 PC0DEI20) 

COMMON /PCODES/PCODE 

THIS SUBROUTINE IS DIMENSIONED FOR A MAXIMUM OF 
40 OBSERVING STATIONS (MAXIMUM) 

15 STATIONS OBSERVING ANY GIVEN PASS 

10 ERROR MODEL UNKNOWNS FOR ANY PASS (FOR A TOTAL OF 16 UNKNOWNS 
FOR ANY PASS). 

DIMENSION OR BN AM (6 ) ,ORBUNK( 16) ,DB ( 16 ) 

DIMENSION A ( 3) ,B ( 16 ) 

DIMENSION DN( 3,3 ,40) ,BN( 3 ,16 ,15 ) ,0K( 3, 40) »DDN( 16,16) ,DDK(16) 

INTEGER*2 LFLG(40) ,KSTAT0(15) , MODEL! 10,2) ,IGUI DEI 10,2) 

DIMENSION EMODEL (10,2) 

EQUIVALENCE (D(l ) ,CI 1 ) ) , ( DI4) , B(l)) 

INTEGER*4 M0DALF(3,2) 

DATA MQDALF/'ZERO* » * SET*,' • , 'REFR • , *ACT 1* , 'ON •/ 

MAXSTA=40 
MAXST0=15 
MAXEMU=10 
MAXUNK=16 
REWIND l 
REWIND 3 
REWIND 4 
REWIND 2 

IF( PCOOE (14) .NE.O ) NSTA=NSTA*i 
C INITIAL ACCUMULATING ARRAYS 
DO 60 KSTA=1,NSTA 
DO 50 J=l»3 
DO 40 1=1,3 
DNOII, J,KSTA)=0.0 
40 DNI I,J,KSTA) =0.0 

50 DK(J»KSTA)=0.0 ' 

VPVSTA(KSTA)=0.0 
60 N0BSTA(KSTA)=0 
WPW=0.0 
WPWSP=0.0 
NOB S=0 
NUNK=0 

READI3) ERD I , XMU I ,OMG I ,R0 , VO 
C RO HOLDS A PRIORI COORDINATES OF CENTER OF MASS 

C VO HOLDS A PRIORI UNCERTAINTIES OF COORDINATES OF CENTER OF MASS 

DO 65 1=1,3 
65 CM ( I ) =R0 ( I ) 
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IF!PC00E!14).EQ.0) GO TO 75 
DO 70 1=1,3 
C UPDATE COORDINATES OF CENTER OF NASS 
CM!I)=STAUVW!I,NSTA) 

C IMPOSE A PRIORI CONSTRAINTS ON COORDINATES OF CENTER OF MASS 
IF( V0( D.EQ.O.O) GO TO 70 
DN! I , I »NSTA) =1 . O/VO ( I ) **2 

DK( I,NSTA)=!RO!I )— STAUVWC I,NSTA))/VO(I) **2 
70 CONTINUE 
75 CONTINUE 
C 

150 CONTINUE 

C PROCESS ANOTHER PASS 
C READ ORBIT HEAOER 

READ! 3 ) IORB,NORB,ORBNAM, EPOCH, I DAY, W3NTH, IYR,GAST,RO,VO»TE» IH,MIN 
1 , ESEC, XPM»YPM»CQNTIN 

WRITE! II IORB, NORB.ORBNAM, 10 AY, MONTH, I YR,IH, MIN, ESEC, EPOCH, CONTIN 
C TEST FOR END OF DATA 

IFICONTIN.EQ.ENDSIGIGO TO 700 

READ14) ORBUNK,NSTATO,LFLG,KSTATO,NEMUNK,EMODEL,MODEL,IGUIDE 
1 , NUTORB 

C INITIALIZE ACCUMULATION ARRAYS 
WPWT0=0.0 
NOBSTO=0 

DO 170 KSTA=1 »NSTATO 
DO 170 J=l, NUTORB 
DO 170 1=1,3 
170 BNf I , J ,KSTAI =0.0 
DO ISO 1=1 , MAXUNK 
DDK ( I ) =0.0 
DO 180 J=l, MAXUNK 
180 DDN C 1 , J I =0.0 

WRITE! 6,6001 ) NOP.B,ORBNAM, IDAY, MONTH, IYR, IH ,M IN, ESEC , EPOCH 

6001 FORMAT !/////////2X,A4,3X,6A8,» EPOCH=' , 13 , A3 , 1 X, 21 3, » H* , 13 , • M • , 

1 F8.4, *S UT=MJD',F17.9) 

WRITE!6,6002) IORBUNK! I ) , 1=1 ,61 

6002 FORMAT ! '0 CURRENT ORBIT ELEMENTS IN APPARENT SIDEREAL CARTESIAN 
1 COORD INATE S' /5X» 'P0SITI0N1METERS) ',4X,3F16.3/ 

l 5X , 'VELOCITY (METERS/ SEC )',3F16.6) 

IF!NEMUNK.EQ.O) GO TO 185 
WRITE ! 6 ,6003 ) 

6003 FORMAT! *0 CURRENT VALUE OF ERROR MODEL UNKNOWNS') 

DO 184 I=1,NEMUNK 

MODCOD=MODEL! 1,1) 

KSTA=MODEL! 1,2) 

184 WRITE! 6,6004) ( MODALF IJ, MODCOD ) , J=1 , 3 ) .KORDER ( KSTA ) , I STANAM! J ,KSTA 
1) ,J=1,5), ORBUNK! 1+6) 

6004 FORMAT ! 5X,3A4, 'FOR STATION ' , 16 , 2X , 5A4,2X , • =» , F 15 .3 ) 

185 CONTINUE 

WRI TE! 6,6005) 

6005 FORMAT! 'OSTATION DATE ', T25 , *T IME !UT) ', 3X, • CORRECTED RANGE*, 2X, 

1 'UNCERTAINTY', 4X, 'MISCLOSURE*) 

C INITIALIZE ORBIT 
NFLG=1 

CALL ORBIT! NFLG,TE,TE,GAST, ORBUNK) 

READ OBSERVATION RECORD 

200 READ 13) TOBS , TO , KSTA, GASTO , SINST, CO SST, RSO, VARRA , ID , IDAY, MONTH, 
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1 IYR • IH, MIN, SEC, S, CONTI N 

IF (CCNTIN.EQ.ENDSIG) GO TO 350 
NN=1 

CALL DRIVER INN, TOBS»GH,DT, XT, UVWT) 

C GET INTERNAL NUMBER OF THIS STATION IN THIS PASS 
ISTA=LFLG(KSTA) 

C TRANSFORM SATELLITE POSITION AND TRANSITION MATRIX TO TERRESTRIAL COORDINATES 
CALL DGMPRD«S,XT,EXT, 3,3*1) 

CALL DGMPRD(S,UVWT,EUVWT,3,3,9) 

COMPUTE STATION TO SATELLITE VECTOR 
DO 220 1=1,3 

220 XS( I)=EXT( I )— STAUVWI I ,KSTA) 

C GET COMPUTED RANGE 
RSC=0.0 
DO 225 1=1,3 
225 RSC=RSC+XS(I>**2 
RSC=OSQRT(RSC» 

C GET STATION TO SATELLITE DIRECTION COSINES AND COMPUTE PARTIALS 
DO 230 1=1,3 

ocsm=xsm/Rsc 
Am=-Dcsm 
230 CONTINUE 

CALL DGMPR0(0CS,EUVWT,D,1,3,9) 

C PREPARE PARTIALS WITH RESPECT TO THE CENTER OF MASS. 

I F I PCODE (14) .NE.O ) CALL DGMPRDt S ,C ,CC, 3,3,1 ) 

C FILL IN B WITH ZEROS 

IF INUT0RB.LE.6) GO TO 250 
DO 234 1=7 *NUTORB 

234 B(I)=0.0 

235 CONTINUE 

CORRECT OBSERVATION FOR ERROR MODEL 
IUNK=IGUIDE IISTA«1) 

IF ( IUNK.EQ .0 1 GO TO 245 
RSO=RSO— ORBUNK ( IUNK) 

B ( I UNK ) =1 .0 

245 IUNK=IGUIDE( ISTA,2) 

IF( IUNK.EQ. 0) GO TO 250 

COEFFICIENT OF REFRACTION TERM IS 1.0/(SIN OF ELEVATION ANGLE) 

C GET SIN OF ELEVATION ANGLE ISE) 

C GEODETIC LATITUDE IS APPROXIMATED BY SPHERICAL LATITUDE IN C IMPUTATION 
C OF SIN OF ELEVATION ANGLE 

SE=0.0 
RST A=0 .0 
DO 246 1=1,3 

SE=SE+ STAUVWI I ,KSTA)*DCS( I ) 

246 RSTA=R STA+STAUVWl I ,KSTA)**2 
SE=SE/DSQRT (RSTA) 

RSO=RSO— ORBUNK ( IUNK ) /SE 

B ( IUNK )=1.0/SE 
250 CONTINUE 
COMPUTE MISCLOSURE 
DL=RSO— RSC 

WRITE! 6,6006) KORDER(KSTA) , I DAY , MONTH, I YR , IH,MIN,SEC,RSO, VARRA,DL 
6006 FORMAT (17, 14, IX, A3, 13, 15, 13, F8 .4, F 13 .2, 2F 15.2) 

WT=1.0/VARRA**2 

WPWOBS=DL*WT*DL 

VPVSTA (KSTA) =VPVSTA( KSTA ) ♦WPWOBS 
WPWTO=WPWTO+WPWOBS 
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NPW=WPW+WPWOBS 
NOBSTA (KSTA ) =NOBSTAl KSTA ) +1 
NOBSTO=NOBSTO*1 
N08S=N0BS«-1 

ACCUMULATE NORMAL EQUATIONS 
DO 270 1=1,3 

DM I, KSTA ) =DK ( I,KSTA)+AtI )*WT*DL 
DO 260 0=1,3 

260 ONI I, J, KSTA) =DN( 1 , J»KSTA ) +A I I)*WT*A( J) 

DO 265 J=1,NUT0RB 

265 BNII,J,ISTA)=BN(I, J,ISTA)*A< 1)*WT*B( J) 

270 CONTINUE 

DO 280 I=1,NUT0RB 
DDK ( I ) =DDK( 1 1 ♦B 1 1 ) *WT*DL 
DO 280 J=1 »NUTORB 
280 DDNII, J)=ODNII,J)*B{ I)*WT*B( J) 

I F ( PCODE 114) .EQ.O ) GO TO 200 
C ACCUMULATE NORMALS PERTAINING TO THE CENTER OF MASS 
00 295 1=1,3 

OKI I »NSTA )=DK( I ,NSTA ) +CC C I )*WT*DL 

00 291 J=l,3 

DNII,J,NSTA) =ONI 1,0, NSTA) +CC 1 1 ) *WT*CCl J ) 

291 DNOi 1,0, KSTA )=ONOI 1,0, KST A ) ♦ A( I )*WT *CC (0 ) 

DO 292 0=1 ,NUTORB 

292 BN 1 1,0 ,NSTATQ)=BN! I ,0 ,NSTATO) ♦CCI I)*WT*BIO) 

295 CONTINUE 

C RETURN TO PROCESS ANOTHER OBSERVATION 
GO TO 200 
C 

350 CONTINUE 

C ENTER ON END OF PASS 
NUN K=NUNK ♦ NU TOR B 

C ADD A PRIORI CONSTRAINTS ON ORBIT UNKNOWNS TO DDN AND DDK AT THIS POINT 
C ADD A PRIORI CONSTRAINTS ON ERROR MODEL UNKNOWNS 
IFINEMUNK.EQ.O) GO TO 370 
DO 369 I =1 ,NEMUNK 
IF( EMODEU 1,2) .LE.O.O) GO TO 369 
DL=EMODEL I I , 1 ) -OR BUNK 1 1+6) 

WT=1.0/EM0DELII,2)**2 

DDN 1 1+6, 1 +6) =DDN I I+6»I+6)*WT 

DDK 1 1 ) =DDK I I ) *WT*DL 

WPWOBS=DL*WT*DL 

N0BS=N0BS+1 

WPW=WPW+WPWOBS 

369 CONTINUE 

370 CONTINUE 

1 Ft NUTORB.EQ . HAXUNK) GO TO 380 
C PAD OUT DDN 

NN=NUT0RB+1 
DO 379 I=NN,MAXUNK 
DDK (I) =0.0 

379 DON II, I) =1.0 
C INVERT DON 

DET=1 .0 

380 CALL DMINVIODN,MAXUNK,DET ,UVWT, B) 

COMPUTE PARTIAL UNCERTAINTIES OF ORBIT UNKNOWNS 

DO 390 1=1, NUTORB 
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390 B ( I )=DSQRT ( DDN ( 1*1)) 

MR I TE ( 6,6008 ) IBI1), I=1»NUT0RB) 

6008 FORMAT {//• PARTIAL UNCERTAINTIES OF ORBIT UNKNOMNS-FROM ODN(INV) • 
1 ,101/8015.6)) 

C 

DO 395 1=1 ,NUTORB 
DO 395 J=1,NUT0RB 

395 WPWSP=WPWSP*DDK( 1 ) *ODN! I » J) *DDK! J ) 

WRITE(l) DON, DDK, BN 

WRITE! 1) NUTORB,NSTATO,NEMUNK,KSTATO,LFLG , OR BUNK, EMODEL, MODEL, 

1 IGUIDE 

RMSTQ=OSQRT ( MPWTO/OFLQATINOBSTO ) I 
WRITE! 6,6007) WPWTO,NOBSTO,RMSTO 

6007 FORMAT ! //5X , "WEIGHTED SUM OF SQUARES OF MISCLOSURES =',F15.3/ 

1 5X, ’NUMBER OF OBSERVATIONS = * , I8/5X, 'RMS MISCLOSURE =',F15.3) 

C RETURN TO PROCESS ANOTHER PASS 
GO TO 150 

ENTER HERE AT THE END OF ALL PASSES 
700 CONTINUE 

WRITE! 2) 0N,DK 

IF! PCODE ! 14I.NE.0) WRITE ! 2) DNO 
REWIND 1 
REWIND 2 
REWIND 4 

C PERFORM ANALYSIS OF MISCLOSURES BY STATION 
WRITE! 6,6019) 

6019 F0RMATI1H1, 8!/) ,10X, 'ANALYSIS OF MISCLOSURES BY STATION'// 

1T10, 'STATION', T40, 'NUMBER OF OBSERVATIONS • ,T70 , 'RMS MISCLOSURE') 

DO 750 KSTA=1,NSTA 

IF! NOBSTA (KSTA).GT.O) RMSMC=DSQRT! VPVSTAC KSTA) /DFLOAT! NOBSTA I KSTA) 
111 

WRITE 1 6,6020) KORDER 1 KSTA ) , ( STANAM! 1 ,KSTA) ,1=1 ,5) , NOBSTA IKST A) , 

1 RMSMC 

6020 FORMAT !T10, 17 , IX ,5 A4, T55 , 17, T70,F14.2) 

750 CONTINUE 

COMPUTE DEGREES OF FREEDOM 
IDEGF=NOBS— NUNK 
WPW=WPW-WPWSP 

RMSMC=DSQRT (WPW/DFLOATC I DEGF )) 

WRITE! 6,6021) NOBS, NUNK, I DEGF, WPW, RMSMC 

6021 FORMAT !////10X, 'TOTAL NUMBER OF OBSERVATIONS' ,T60,I8// 

IlOX, 'TOTAL NUMBER OF ORBIT AND ERROR MODEL UNKNOWNS' ,T60 , 18// 

210X, 'CORRESPONDING DEGREES OF FREEDOM' ,T60, 18// 

310X, 'TOTAL SUM OF SQUARES OF MISCLOSURES, I.E.,VPV*XU» ,T60,F11.2// 
410X, 'CORRESPONDING STANDARD DEVIATION OF UNIT WEIGHT* , T60, Fll .2 ) 
RETURN 
END 
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SUBROUTINE POLEIDT, XPM,YPM) 

DOUBLE PRECISION DT,XPM,YPM 
DIMENSION PM(286,2),PMT(2) 

DIMENSION PMXI (90) ,PMY1(90) »PMX2{ 90 ) »PMY2( 90) » PMX3 ( 15 ) »PMY3( 15) 
EQUIVALENCE (PM, PMXI) ,(PM( 1,2) »PMYl) ,(PM(9I,I) ,PMX2) , 

1 (PM (91,2) ,PHY2),(PM( 181,1 ) t PMX3 ) , (PMH81 ,2 ) ,PMY3) 

DIMENSION PMX4(5) ,PMY4(5) 

EQU IVAL ENCE f PN( 1 96, 1 ) , PM X4) , ( PM< 196 ,2 > , PMY4) 

DIMENSION PMX5(86) ,PMY5(86) 

EQUIVALENCE ( PM(201, 1 ) , PMX5 ) , ( PM( 201 ,2 ) , PHY5 ) 

C POLAR MOTION TABLES FURNISHED BY TOMLINSON (TAKEN FROM IPMS) 

DATA PMXI/ 


1-0.173,-0.215,-0.235,- 

-0.237, 

-0.218,-0.162, 

-0.097,-0.032, 

0.036, 

2 0.111, 0.188 

0.237, 

0.348, 

0.398, 0.398, 

0.368, 0.330, 

0.280, 

3 0.218, 0.144 

0.069, 

0.000, 

-0.062,-0.112, 

-0.140,-0.153,-0.151, 

4-0.126,-0.086 

-0.037, 

0.026, 

0.092, 0.161, 

0.223, 0.272, 

0.299, 

5 0.308, 0.296 

0.261, 

0.202, 

0.135, 0.073, 

0.046, 0.035, 

0.013, 

6-0.026,-0.072 

-0 .096 , 

-0.107, 

-0.103,-0.087, 

-0.039, 0.004, 

0.040, 

7 0.070, 0.080 

0.109, 

0.117, 

0.117, 0.109, 

0.092, 0.074, 

0.065, 

8 0.064, 0.062 

0.057, 

0.046, 

0.034, 0.030, 

0.0 32 , 0.040, 

0.043, 

9 0.042, 0.041 

0.039, 

0.028, 

0.019,-0.010, 

-0.027,-0.021,-0.009, 

A 0.008, 0.027 

0.047, 

0.071, 

0.095, 0.120, 

0.144, 0.162, 

0.173 / 

DATA PMX2/ 






1 0.171, 0.157 

0 .128 , 

0.094, 

0.056, 0.017, 

-0.019,-0.054, 

-0.086, 

2-0.110,-0.121 

-0.119, 

-0.105, 

-0.076,-0.038, 

0.009, 0.070, 

0.134, 

3 0.191, 0.239 

0.274, 

0.301, 

0.281, 0.237, 

0.176, 0.112, 

0.048, 

4-0.011,-0.069 

-0.122, 

-0.171, 

-0.206,-0.194, 

-0.169,-0.139, 

-0.101, 

5-0.055, 0.004 

0.074, 

0.164, 

0.214, 0.240, 

0.241, 0.239, 

0.255, 

6 0.250, 0.219 

0.161, 

0.099, 

0.042,-0.012, 

-0.067,-0.120, 

-0.160, 

7-0.185,-0.196 

-0.194, 

-0.174, 

-0.130,-0.072, 

-0.003, 0.071, 

0.127, 

8 0.168, 0.201 

0.221, 

0.227, 

0.220, 0.194, 

0.138, 0.075, 

0.033, 

9 0.000,-0.029 

-0.058, 

-0.086, 

-0.105,-0.116, 

-0.119,-0.115, 

-0.104, 

A-0. 086, -0.057 

-0.010, 

0.052, 

0.096, 0.117, 

0.125, 0.123, 

0.115/ 

DATA PMY1/ 






1 0.022, 0.098 

0.187, 

0.265, 

0.328, 0.389, 

0.443, 0.478, 

0.493, 

2 0.478, 0.447 

0.411, 

0.365, 

0.307, 0.235, 

0.165, 0.097, 

0.043, 

3-0.007,-0.038 

-0.057, 

—0.064, 

-0.057,-0.025, 

0.032, 0.120, 

0.211, 

4 0.285, 0.340 

0.372, 

0.393, 

0.406, 0.410, 

0.401, 0.370, 

0.320, 

5 0.260, 0.201 

0.143, 

0.090, 

0.043, 0.007, 

-0.012,-0.007, 

0.025, 

6 0.059, 0.094 

0.123, 

0.153, 

0.182, 0.209, 

0.238, 0.263, 

0.288, 

7 0.300, 0.306 

0.301, 

0.288, 

0.271, 0.249, 

0.220, 0.189, 

0.161, 

8 0.150, 0.151 

0.158, 

0.161, 

0.160, 0.155, 

0.153, 0.150, 

0.151, 

9 0.154, 0.157 

0.165, 

0.174, 

0.191, 0.212, 

0.242, 0.276, 

0.297, 

A 0.309, 0.314 

0.312, 

0.304, 

0.290, 0.271, 

0.246, 0.214, 

0.175/ 

OATA PMY2/ 






1 0.132, 0.092 

0.068, 

0.060, 

0.067, 0.083, 

0.104, 0.128, 

0.160, 

2 0.200, 0.248 

0.295, 

0.329, 

0.356, 0.376, 

0.388, 0.387, 

0.375, 

3 0.349, 0.307 

0.251, 

0.193, 

0.139, 0.091, 

0.046, 0.008, 

-0.020, 

4 0.005, 0.041 

0.078, 

0.120, 

0.168, 0.230, 

0.294, 0.353, 

0.412, 

5 0.455, 0.467 

0.459, 

0.436, 

0.394, 0.339, 

0.275, 0.219, 

0.168, 

6 0.123, 0.085 

0.060, 

0.046, 

0.043, 0.049, 

0.069, 0.103, 

0.153, 

7 0.226, 0.286 

0.334, 

0.374, 

0.408, 0.434, 

0.444, 0.433, 

0.399, 

8 0.349, 0.303 

0.259, 

0.221, 

0.186, 0.156, 

0.131, 0.114, 

0.103, 

9 0.098, 0.100 

0.108, 

0.124, 

0.149, 0.181, 

0.215, 0.255, 

0.298, 

A 0.330, 0.344 

0.345, 

0.337, 

0.324, 0.308, 

0.291, 0.273, 

0.253/ 

DATA PMX3/ 






1 0.099, 0.079 

0.056, 

0.031, 

0.012,-0.001, 

-0.006,-0.008, 

-0.002, 

2 0.012, 0.035 

0.055, 

0.046, 

0.027, 0.008 

/ 
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DATA PMX4 /-O. 010, -0.029,-0. 049, -0.063»-0. 066/ 

DATA PMY3/ 

1 0.233, 0.213, 0.194, 0.177, 0.165, 0.157, 0.155, 0.154, 0.152, 

2 0.156, 0.163, 0.172, 0.183, 0.195, 0.208 / 

DATA PMY4 / 0.220, 0.234, 0.249, 0.269, 0.289/ 

DATA PMX5/ 

1— .056,— .037,— .014, .008,. 031,. 051,. 064, .067,. 064, .060,. 088,. 119, .10 
26 , .054,. 008, -.027, -.056, -.084, -.109, -.123, -.127, -.120, -.102 

3, -.073, -.033,. 010,. 052,. 091, .125,. 154, .174,. 185, .184, .168, .127, .07 
47 , .029,— .021,— .071,— .115 ,-. 157,-. 184,— . 184,— . 166,— .135,— . 100,— .06 
53 ,-.025,. 017,. 083,. 154,. 210,. 241,. 250,. 238,. 2 07,. 167,. 119,. 068, 
6.019,— .045,— . 127,— .211,-. 242 ,—.225,— .184,— .135 ,—.078,— .027 , .026, 

7. 086.. 150.. 214.. 261.. 270. .256. .220 . .177. . 143. . 114. .071. .015, -.015, 
8-. 042, -.081, -.125/ 

DATA PMY5/ 

1.302.. 308.. 308. .302. .290. .276. . 260 .. 245. . 231 .. 216. .202. . 183. .166, 

2.157.. 156.. 161.. 172, .197,. 233,. 265,. 289,. 310,. 330,. 350,. 370, 

3. 386.. 392.. 386.. 367. .337. .302.. 260.. 212. .167.. 134. .115 . .105. . 104, 

4. 114.. 134.. 168.. 216. .273.. 333.. 384.. 419.. 449.. 465. .463.. 436. .391, 

5. 347.. 303.. 252.. 196.. 148.. 112.. 080.. 045.. 017.. 020.. 052.. 097.. 149, 

6. 204.. 270.. 340.. 389.. 443.. 478 ..482.. 468. .444.. 409. .337.. 276. .236, 

7. 160.. 166.. 122.. 070.. 033.. 030.. 053.. 109.. 174, 

A=IDT-0. 3620386 105)90.547581850-1 

L=A>1 .0 

I F ( L. LT. 2 1G0T0901 
1F(L.GT .284) GO TO 901 
TL=L 

AN=A+1.0-TL 
B=AN*I AN— 1 .0)/4.0 
00101=1,2 

0EL0=PH( L, I ) -PM( L— 1, 1 ) 

DEL1=PM(L+1,I)— PMIL, I) 

DEL2=PM(L*2» I )— PM( L*T , I ) 

PUT (I)=PM(L,I) ♦AN9DEL1*B4 (0EL2— OELO ) 

10 CONTINUE 
XPM=PMTI1) 

YPM=PMT<2) 

RETURN 

901 WR I TE( 6,9001 ) 

9001 FORMAT (72H0TA8LES OF POLAR MOTION COVER ONLY FROM 1958.0 TO 1972.2 
15, PLEASE EXTEND) 

STOP 

END 
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SUBROUTINE KEPTCE (ORBEL.Z ) 

CONVERT FROM KEPLERIAN TO CARTESIAN ORBIT ELEMENTS 
C (EPOCH POSITION AND VELOCITY VECTORS) 

IMPLICIT REAL*8(A-Z1 

COMMON /ERDCON/AE , GM , OMG I »XCM,YCM»ZCM 
DIMENSION 0RBEL(6) ,ZC6) ,RXQ(3,3) ,Q(3,2 ) 

DATA RHOD/ 57.295779513082/ 

A S 0RBEL( 1 ) 

ECC=0RBEL(2 ) 

INC=ORBEL (3 I/RHOD 
NODE=ORBEL( 4) /RHOD 
ARGP=ORBEL ( 5 ) /RHOD 
M=ORBEL ( 6 ) /RHOD 
C 

CALL KEPEQ( M, ECC, 1 .00— 12»E) 

CE=DCOS(E) 

SE=DSIN(E> 

Q ( 1 • 1 ) =A* ( CE— ECC ) 

Q ( 2 , 1 ) =A*DSQRT ( 1 . 0-ECC**2 ) * S E 

Q(3,l>=0.0 

N=DSQRT(GM/A**3) 

FACTOR =N*A/( 1.0— ECC*CE) 

Q(lt2)=-SE*F ACTOR 

Q ( 2 , 2 ) =DSQRT( 1 .0-ECC**2 ) *CE*FACTOR 
Q( 3*2) =0.0 
CN=OCOS (NODE ) 

SN=DSI N( NODE ) 

CW=OCOS( ARGP ) 

SW=DSIN( ARGP) 

CI*DCOS( INC) 

SI=DSIN( INC ) 

RXQ(1,1)=CN*CW-SN*CI*SW 
RXQ ( l t 2 ) =-CN*SW-SN»C I *CW 
RXQ(1,3)=SN*SI 
RXQ(2,1)= SN*CW+SW*CN*C I 
RX0(2 , 2 ) =-SN*SW+CH*CN*C I 
RXQ(2»3I=— CN*SI 
RXQ(3,2)=CH*SI 
RX0(3f 1 )=SW*Sl 
RXQ(3»3)=CI 

CALL DGMPRD(RXQ,Q(1,1),Z( 1) ,3,3,1) 

CALL DGMPRD(RXQ,Q(1,2),Z(4) ,3,3 ,1) 

RETURN 

END 
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SUBROUTINE KEPEQIM .EC. CONV. E) 

IMPLICIT REAL*8(A-H,K-Z) 

E=M*EC*OSINIH> 

DO 10 1=1.50 

DELE=< M-E«-EC*OSIN< EJJ / (1 .0-EC*0C0S t E 1 1 
E=E+DELE 

IF ( DABS ( DELE ) . LT.CONV) GO T020 
10 CONTINUE 

WRITE! 6. 100) 

100 FORMAT (52HKEPLERS EQUATION FAILS TO CONVERGE I N 50 ITERATIONS 
20 RETURN 
END 
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SUBROUTINE ORBI TINFLG , TON, TEN, ALE I »X IN ) 

IMPLICIT REAL*8 ( A— H,Q— Z ) 

DIMENSION 

1 XPO(IO) »YPOI 10) ,ZP0( 10) ,UMT(224) , VMT{ 224) ,UVM < 180 ) ,XINC 6) 

2 »CNM( 15 ) , SNMI 15) »CTT( 15) * CTB ( 15 ) ,LCT (6 } , ICT( 8 ) »XM( 6) 

DIMENSION CMC (3 ) ,CMI (3 ) 

COM NON /ORBPAR/TZE, STEP, ALF,OMG, EPS, CUD, CUV, CUT, XM,XPO,YPO,ZPO,UVM 
i,CMC 

COMMON /ERDC0N/ERD1 ,XMUI ,OMGI , XCM, YCM ,ZCM 
EQU I VALENCE (CMI ( 1 ) ,XCM) 

VALUES OF SPHERICAL HARMONIC COEFFICIENTS FROM SAO 1969 STANDARD EARTH 
C20.5 FIELD SAO 1969 

DATA C W/l. ODO, O.ODO, 10826280-02, 0.2 5380D-05, 0.159300-05,2*0. DO, 

1 0.21276D-5, -.502700-06, 0. 15575D— 05 , .30469D-O6, .738440-07, 

2 .95700D-07,. 591300-07, -.16838D-08/ 

DATA SNM/7*0. 000,. 28099D-06,-. 462630-06, -.8805 20-06,-. 21 6780-06, 

1 .1 5794D-06, .19946D-06,— .92433D-08, .71686D-08/ 

ARRAYS OF CONSTANT DEPENDING ON DEGREE AT WHICH GRAVITY FIELD IS TRUNCATED 
DATA LCT/5,4,3,2 , 1,0/ 

DATA CTT/— 2. ODO,— 4.0D0,— 6.000,— 8. ODO ,-10. ODO, -2. ODO, -4. ODO, 

1 -6. ODO, -8. ODO, -2 .ODO, -4. ODO, -6. ODO, -2. ODO, -4. ODO, -2.0D0/ 

DATA CTB/2. ODO, 6. ODO, 12. ODO, 20. ODO, 30. 000, 2. ODO, 6. ODO, 12. ODO, 

1 20.0D0, 2. ODO, 6.0D0, 12. ODO, 2.000,6. 000,2.000/ 

CNMI2) =ZCM/EROI 
CNM (6 ) =XCM/ERO I 
SNMC6) =YCM/ERDI 

C USE THIS VALUE FOR COMPARSION PURPOSES ONLY 
CNM( 5 ) =0 • 15903E— 05 
KFLG=1 
NTE=5 
NHT=0 
KRG=0 
KDR=0 
KV=0 
KT=10 
KTR=KT 

NFLG=0 MEANS TO COMPUTE THE CONDITIONS AT TEN FROM TON AND 
RETURN THE NEW POSITION AND VELOCITY ELEMENTS IN XIN 
NFLG=1 MEANS TO UPDATE THE ORBIT FROM TON TO TEN IF NECESSARY AND TO 
INITIALIZE THE SERIES COEFFICIENTS AT TON 
NFLG=2 INDICATES THAT THE EXPANSIONS ALREADY EXIST FOR THIS ORBIT, 

BUT THE ORBIT IS TO BE INTEGRATED UP TO TEN AND NEW EXPANSIONS 
FORMED ABOUT THAT POINT 
IFINFLG-1) 150,120,240 
120 00 130 1-1,36 
130 UVM(I)=0.0 

DO 140 1=1, 9, 4 
UVMII+27>=1.0 
140 UVMII ) =1.0 
150 CONTINUE 
10 CONTINUE 
C 

COMPUTE CONONICAL UNITS' AND INITIALIZE CONSTANTS 

CUM=XIN(1)*XIN(1)+X1N(2)*XIN(2)*XIN(3)*XIN(3) 

CUD=DSQRT(CUM) 

CUM=CUM*CUD 
CUT=DSQRT(CUM/XMUI ) 

CUV=CUD/CUT 
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ERD=ERDI /CUD 
XMU=1.0 
ALF=ALFI 
OMG =OMG I *CUT 
EPS=0. 04/CUD 
XPO! 1 ) =X IN! 1 l/CUD 
YP0I1I=XIN!2)/CUD 
ZPO!ll=XINI3 l/CUD 
XPOI2)=XIN!4»/CUV 
YPOI2)=XINI 51/CUV 
ZPOI2l=XINI6l/CUV 
TIN*TON/CUT 
TFI=TEN/CUT 
DO 180 1=1,3 
180 CMC ( IT =CMI ( I l/CUD 
200 CONTINUE 
TZE=TIN 
DELT=TFI— TZE 

IF IDABSI DELT) .GT.O.O) GO TO 220 
KFLG=2 

IPINFLG.NE.O) GO TO 220 
C SET UP RETURN FOR NFLG=0 

XIN1L)=XP0!1)*CUD 
XIN(2) »YP0(1I*CU0 
XINI3)=ZP0I1>*CUD 
XINI4)=XP0!2 I*CUV 
XINI5T=YPOI2»*CUV 
XIN(6)eZP0(2)«CUV 
RETURN 
220 CONTINUE 
KEY=KFLG 

CALL EXPAND IXPO.YPO, ZPO,CNM,SNM,LCT, ICT,UHT,VNT,CTB,CTT 

1,ERD,XMU»ALF»0HG»ECC»NTE»KTR,KDR»NHT,CDC»CTW»KEY»DMT»KRG,CHC) 

ICN=l 

CALL UPDATE I ICN,KTR,EPS*STEP,XPO,YPO V ZPO,XM!1 » ,XM|3) »XM( 5 I I 
IFIKFLG.NE.2) GO TO 250 

CALL VARIEQfXPO* YPO»ZPOf CNM» SNM,LCT, ICT»UMT»VMT»UVM»ERDt ALF, OMG»CO 
1C » C TW » NTE , KTR , KDR ) 

C WRITE! 6,356) TFI .STEP, ALF, OMG. EPS, CUD, CUV, CUT, XPO, YPO,ZPO,UVM 

356 FORMAT 121 4E20. 12/) ,6I5E20. 12/1 ,30!6E20. 12/1) 

RETURN 

C ENTER HERE WITH NFLG=2 
240 TIN=TON 
TFI=TEN 
TZE=TIN 
DELT=TFI-TZE 

INTEGRATE ORBIT 
250 DEL=DELT 

I F I DABS! DELT » .GT. STEP I DEL=DSIGN< STEP , DELT) 

ICN=2 

CALL UPDATE! ICN, KTR, EPS,OEL,XPO,YPO,ZPO,XMm ,XMI3> ,XM!5) ) 
TIN=TIN+DEL 
ALF=ALF*DEL*OMG 

C WRITE! 6,356) TIN, DEL, ALF,OMG,EPS,CUO t CUV,CUT,XPO,YPO*ZPO,XM 
XPO! 1) =XMI 1) 

YPO II ) =XM!3 I 
ZPOIl) =XM!5) 
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XP0(2)=XM<2) 
VP0(2)=XM4) 
ZP0(2)=XM(6) 
GO TO 200 
END 
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SUBROUTINECLEARi A»N) 

IMPUC ITREAL*8 < A-H ,0-Z I 

PILL A ARRAY WITH FLOATING POINT ZEROES. 


DIMENS IONA(l) 
C 

DOlOJ-ltN 
10 A ( J ) =0 . 
RETURN 
END 
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SUBROUTINE DRIVER INN»TM»GH,DT »XOT »VEM> 

IMPLICIT REAL*8(A-H,0-Z) 

DIMENSION XOT(l) yVEM(l) 

DIMENSION XM(6) »XPO( 10) ,YPO( 10) «ZPO( 10 l t UVMI 180) 

DIMENSION ANTI 36) 

COMMON /ORBPAR/TEPtOLTtALF.OMGf EPStCUDfCUVfCUTfXMfXPOfYPOfZPOtUVM, 

1 CMC( 3 ) 

50 TOT=TM/CUT 

51 DEL=TOT— TEP 
NFLG=1 

IF(OABStDEL) .LT.DLT) GO TO 67 

C TIME FROM T ZERO IS TOO LARGE FOR CONVERGENCE OF SERIES 

C INCREMENT T ZERO BY ONE STEP 

DEL=OS IGN(DLTfDEL) 

NFLG=2 

67 CONTINUE 
KTR=9 

CALL MATRUP (KTRf DELtUVMf AMT) 

I F (NFLG.EQ. 1 ) GO TO 69 
DO 68 1=1,36 

68 UVM(I)=AMT(I) 

TON=TEP 

TEN=TEP*DEL 

ALFI=ALF 

CALL ORBIT INFLG»TON»TEN»ALFI , XOT) 

GO TO 51 

69 CONTINUE 
GH=ALF«OEL*OMG 
KTR=10 

ICN=2 

100 FORMAT <6E18«5) 

CALL UPDATE I ICN,K TR, EPS, DEL ,XPO, YPO ,ZPO,XM 1 1) ,XM( 3 ) ,XMI 5 > > 

XOT ( 1 ) =XM ( 1 ) *CUD 
XOT (2) =XM( 3>*CUD 
XOT (3) =XM( 5) *CUD 
X0TI*)=XM(2)*CUV 
XOT 15 ) =XM I A) *CUV 
XOT (6) =XM(6)*CUV 
J=10 
K=19 

DO 70 1=1,9 
VEM (J) =AMT I I ) 

VEM (K) =AMT( J )*CUT 
VEM ( I ) =— VEM ( J ) 

J=J*1 

K=K+1 

70 CONTINUE 

DO 80 1=1,9,* 

80 VEM C I )=VEM( I )*1.0 
RETURN 
END 
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SUBRQUTINEUPD ATE ( ICNtKTR, EPS * DE L* XPO* YPO»ZPO»XOT» YQT* ZOT) 
IMPLICITREAL*8(A-H,0-Z) 

DIMENS IONXPOI 1 ) *YPOI 1) *ZPO( 1 ) »XOT (l)»YOT(l)»ZOT(l) 

ICN=1 - COMPUTE STEP (DEL) KTR - NUMBER OF TERMS TO USE 

ICN=2 - INTERGRATE POS.»V£L. EPS - TRUNCATION ERROR LIMIT 
ICN=3 - DO BOTH TOGETHER DEL - VALID STEP SIZE 

INITIAL AND FINAL ADDRESSES FOR X,Y,Z MAY BE SYNONYMOUS. 

KA=KTR 
KB= ICN-2 
IF(KB) 10*20*10 
10 CONTINUE 
C SCALE DATA TO REMAIN IN COMPUTER RANGE 
B=1.0 

A=DSQRT( (B*XPOCKA) )**2'MB*YPQtKA) ) **2+(B*ZP0(KA) )**2) 
A=DLOG((B*EPS)/A) 

B=KA-1 

DEL=DEXP(A/B) 

IF (KB) 40*20 «20 
20 XPI=XPO(KA) 

YPI=YP0(KA) 

ZPI=ZPO(KA) 

KA=KA— 1 

KB=KA 

A=KA 

XVI=XPI*A 

YVI=YPI*A 

ZVI=ZPI*A 

DT=DEL 

D030I*2,KB 

XPI=XPI*DT*XPO(KAJ 

YPI=YPI*DT+YPO(KA) 

ZP I =ZP I *DT*ZPO( KA ) 

A=K A— 1 

XVI=XVI*DT+A*XPO(KA> 

YVI=YVI*OT+A*YPO(KA) 

ZVI=ZVI*DT*A*ZPO(KA) 

KA=KA— 1 
30 CONTINUE 

XOT ( 1) =XP I*DT*XPO( 1 ) 

YOT ( 1 ) =YPI *DT+YPO( 1 ) 

ZOT (1) =ZP I *DT+ZPO ( 1 ) 

XOT (2) =XVI 
Y0T(2) =YVI 
ZOT (2)=ZVI 
40 RETURN 
END 
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SU8R0UTIN£HATRUP{KTR» D£L»UVM, TAR J 
1MPLIC ITR£AL*8(A-H,0-I) 

DIMENS IONTAR( 36 } »UVM( 1) , UVO( 1) 

SUBROUTINE TO UPDATE THE NATR1ZANT WITH RESPECT TO TIME (DEL). 


L=KTR 

N=18*(L-II+1 
DOIOI=l,18 
TAR ( I ) =UVM(N ) 

TAR ( I* 18 ) =0.0 
10 N=N+1 

D020I=2»L 
N=18*(L-I)+1 
M=N-*-18 
TM=L-I *1 
D020K=1,18 

TARIK)=0EL*TARIK)+UVH(N» 

T AR < K* 18 > =DE L*T ARIK+18) ♦ TM*U VM ( Ml 

N=N«-1 

M=M+1 

20 CONTINUE 
RETURN 
END 
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SUBROUTINE ROT3IANG,X) 
IMPLICIT RE AL*8 C A— H» 0— Z I 
DIMENSION X ( 3) t XX ( 3) 
COS=DCOS ( ANG ) 

SIN=DSIN( ANG) 
XX(1)=C0S*X(1I*SIN*X(2) 
XX(2)=-SIN*X(1H-C0S*XC2> 
DO 100 1=1 , 2 
100 X(I)=XX(I) 

RETURN 

END 
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SUBROUTINE ORBRN 

C FORM REDUCED NORMAL EQUATIONS FOR UP TO 40 STATIONS 
C FOR SHORT ARC MODE PROCESSING 
IMPLICIT REAL*8( A— H»0— Z) 

COMMON /NSTA/NSTA 
INTEGER*2 PC0DEC20) 

COMMON /PCODES/PCODE 
COMMON /WPW/WPW.XPU » I DEGF • IFSTA 
INTEGER CONTI N» END SIG/1HE/ 

COMMON /ST AOR O/KOR DER ( 1 50 > 

COMMON /N0RMEQ/REDN13, 3, 820) ,U( 3 ,40) ,L( 820 ) .LSOLVE 
DIMENSION 8N C 3, 16, 15), DUMMY (3, 3, 40), DDNC 16,16) ,DDK ( 16 ) , BNDDN I ( 3 , 

1 16) , DDK3 ( 3 ) 

INTEGER42 L,L SOLVE, LG (40) ,IDAY, IYR .KSTATO ( 15 ) 

DIMENSION 0RBNAMI6) 

EQUIVALENCE (BN( 1,1 ,1) .DUMMY (1,1,1) ) , (D0K3 ( 1 ) ,DDK (1 ) ) 

L0C(K)=(K*(K+l))/2 
MAXSTA=40 

IF(NSTA.GT.MAXSTA) GO TO 901 

THE REDUCED NORMAL EQUATIONS ARE STORED AS 3 X 3 BLCCKS IN THE ARRAY REDN 
ONLY THE UPPER TRIANGULAR PART OF THE REDUCED NORMAL EQUATIONS IS STORED. 
THE BLOCKS OF THE REDUCED NORMAL EQUATIONS ARE NUMBERED 
ACCORDING TO THE FOLLOWING SCHEME: 


1 2 

4 

7 

11 


3 

5 

8 

12 



6 

9 

13 




10 

14 





15 

ET CETERA 

L(820) IS THE 

GUIDE 

MATRIX 



L=1 SIGNIFIES A NON ZERO BLOCK 
L=0 SIGNIFIES A ZERO BLOCK 
REWIND 1 
REWIND 2 
IB=LQC (NSTA) 

DO 100 JB=1,IB 
DO 99 1=1,3 
DO 99 J= 1 , 3 
99 REDN( 1 , J, JB ) =0.0 
100 L(JB)=0 

READ (2) DUMMY, U 

STASH DIAGONAL BLOCKS 
DO 110 KSTA=l,NSTA 
IB = LOC (KSTA ) 

DO 108 1=1,3 
DO 108 J=1 , 3 

108 REDN( I , J, IB) =DUMMY ( I , J.KSTA ) 
110 CONTINUE 

IF(PC0DE(14).EQ.0) GO TO 130 

READ<2) DUMMY 

NN=NSTA-1 

IB=LOC(NN) 

DO 120 KSTA=1 ,NN 
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NB=IB*KSTA 
00 120 1-1,3 
00 120 J=l,3 

120 REDN(I,J,NB)=DUMMY(I,J,KSTA) 

130 CONTINUE 

FDEGF=IDEGF 

I F ( PC00E ( 9 ) »EQ. 1 ) WRITE!?, 70101 FDEGF, WPW 
7010 FORMAT (16X,2F16.6) 

READ BLOCKS FROM EACH ORBIT ANO REDUCE NORMAL EQUATIONS. 

150 READ (1) I ORB ,NQRB ,ORBNAM , ID AY , MONTH, I YR , IH , MI N, ESEC , EPOCH ,CQNT IN 
IF END OF DATA, GO OUT OF LOOP 
IF(CONTIN.EQ.ENDSIG) GO TO 400 
READ (1) DON, DDK, BN 

READ (II NUTORB,NSTATO,NEMUNK,KSTATO 
DO 180 IS=l,NSTATO 
ISTA=KSTAT0(IS) 

GET BN ♦ DON! INVERSE I 
DO 160 1=1,3 
DO 160 J=1»NUT0RB 
BNDONI (I, J 1=0.0 
DO 160 K=1,NUT0RB. 

160 BNDDNI ( I » J)=BNDDNI ( I , J) +BN( I ,K, IS) *DDN(K» J I 
DO 165 1=1,3 
DO 165 K=1,NUT0RB 

165 U ( I « ISTA I =U( I , I STA I —BNDDNI ( I ,K ) *DDK( K I 
DO 180 JS=1,NSTAT0 
JSTA=KSTATO(JS) 

SKIP IF (ISTA.GT.JSTA) , SINCE ONLY THE UPPER TRIANGULAR PART OF THE 
REDUCED NORMAL EQUATIONS IS 8EING COMPUTED AND SAVED. 

IF( ISTA.GT. JSTA) GO TO 180 
NB=L0C(JSTA-1I+ISTA 
DO 170 1=1,3 
00 170 J=l»3 
DO 170 K=l,NUTORB 

170 RE0N(I ,J,NB)=REDN(I,J,NB)-BNDDNI( I,K)*BN( J,K,JS) 

L(NBI=L(NB)+1 
180 CONTINUE 

RETURN TO PROCESS ANOTHER PASS 
GO TO 150 

ENTER HERE WHEN ALL PASSES HAVE BEEN PROCESSED 
400 CONTINUE 

SIMULATE KRAKIWSKI * S GUIDE MATRIX 
IF(PC00E(6I.NE.l) GO TO 441 
C 

WRITE! 6,6001 I 

6001 FORMAT (1H1, 10 (/),20X, 'GUIDE MATRIX') 

DO 440 ISTA=1,NSTA 
IB=0 

LG (1>=1000 

00 435 JSTA=ISTA,NSTA 
JB=L0C ( JSTA-1 I *1 STA 
IF(L(JBJ .EQ.O) GO TO 435 
IB=IB>1 

LG(IBI=KOROER(JSTA) 


- 131 - 



n o 


435 CONTINUE 


18=18+1 

IF! IB.GT.l) LG ! IB ) =999 

439 WRITE! 6,6002) KORDER! ISTA) , < LG! I) , 1=1, IB) 

6002 F0RMAT120X, 15, 5X, 1815, 2001/30X, 1815) ) 

440 CONTINUE 

441 CONTINUE 

PRINT NORMALS IN ASO FORMAT, AND PUNCH IF DESIRED. 

WRITE! 6, 6003) 

6003 FORMAT I 1H1// • NORMAL EQUATIONS !SEE GUIDE MATRIX)*//) 

DO 450 ISTA=1,NSTA 

00 442 1=1,3 

442 DDK! I ) =— U! I , ISTA ) 

IB=0 

JB=L0C1ISTA) 

IFILIJB) .GT.O) 18=1 
C PUNCH NORMALS 

I F i PC0DE19) .NE.l ) GO TO 443 
WRITE! 7, 7001) KORDER (ISTA) 

7001 FORMAT! 1415) 

WRITE 17, 7006) DDK3 
7006 F0RMAT!3!F16.10,5X)) 

WRITE (7,7008 ) ( 1REDNI I ,J, JB) ,J=1,3), 1=1,3) 

7008 FORMAT I3F16 .10/3F16.10/3F16.10) 

C 

443 CONTINUE 

C PRINT DIAGONAL BLOCK 

IF 1 PC0DE17) .NE.l ) GO TO 444 
WRITE <6, 6004) KORDER! ISTA) 

6004 FORMAT ! //I5 ) 

WRI TE! 6,6006) DDK3 
6006 FORMAT !/3(F16*10,5X) ) 

WRITE! 6,6008) ! CREDN! I ,J, JB) ,J=1,3), 1=1,3) 

6008 F0RMATI3F16.10) 

444 CONTINUE 

C PRINT OFF-DIAGONAL BLOCKS 
KST A=ISTA+1 

IF! 1STA.EQ.NSTA) GO TO 448 
DO 445 JSTA=KSTA,NSTA 
JB= LOC I JS TA-1 ) ♦ I STA 
IF!L!JB).EQ.O) GO TO 445 
IB=IB+1 

IF! PCOOEI9) .NE.l ) GO TO 7445 
WRITE! 7,7001) KORDER (JSTA) 

WRITE! 7,7008) ! I REDNI I ,J , JB) , J=l,3) , 1=1 ,3 ) 

7445 CONTINUE 

IFIPCODE (7) .NE.l ) GO TO 445 
WRITE! 6, 6004) KORO ER! JSTA) 

WRITE! 6,6008) ! IREDN! I ,J, JB) ,J=1,3), 1=1,3) 

445 CONTINUE 
448 1=1000 

IF! IB. GT.O) 1=999 
IF!PC0DE!7).EQ.l) WRITE 16, 6004) I 
IF! PC0DE19) . EQ.l) WRITE!7,7001) I 
450 CONTINUE 

IFIPCODE! 8) .NE.l) GO TO 478 


- 132 - 



WRITE ( 6, 6010 ) 

6010 FORMAT C 10 ( / ) ,ZOX, 'OBSERVATIONS ON EACH LINE 1 ) 

IB=NSTA— 1 

DO 475 ISTA=1 * IB 

KSTA=ISTA+1 

DO 475 JSTA=KSTA»NSTA 

WR I TE( 6«601 1 ) K ORDER ( ISTA) t KORDER ( JSTA ) » L (LOCI JSTA— l )+ISTA) 

6011 FORMAT (8110) 

475 CONTINUE 
478 CONTINUE 

RETURN 
901 CONTINUE 

WR ITE( 6y9001 ) MAXSTA t NSTA 

9001 FORMAT ( • FORMRN IS PRESENTLY DIMENSIONED TO HANDLE ONLY*, 15. 

1* UNKNOWN STATIONS. '/20X* * THIS PROBLEM HAS*,I5,* UNKNOWN STAT 
2 I0NS.'/10X« 'EXECUTION IS TERMINATED BY PROGRAM.*) 

STOP 

END 
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SUBROUTINE PORB 

C PRINT UPOATED ORBIT ELEMENTS AND ERROR MODEL TERMS 
IMPLICIT REAL*8(A— H,0— Z) 

COMMON/NSTA/NSTA 

COMMON /WPW/WPW»XPU» IDEGFfNPSTA 

INTEGER*2 PC ODE C 20 ) 

COMMON/PCODES/PCODE 
INTEGER STANAMt IDS*2 

COHKON/STALOC /STAUVM (3 « 150 ) . DATPRM (2,15), DATNAMf A, 15 ) , 

1STANAM (5,150), IDS ( 150) 

COMMON /STAORD/KORDER (150) 

DIMENSION DX( 3,40) , DDN( 16, 16) ,DDK( 16) ,BN(3,16,15 ) ,DDKM( 16) 

INTEGER C0NTIN,ENDSIG/1HE/ 

INTEGER*2 LFLG(40) ,KSTAT0(15) ,MODEL( 10,2) ,IGUI DE ( 10, 2 ) 

INTEGER42 IOAY, IYR 

DIMENSION EMODEL( 10,2) ,0R8NAM( 6 ) ,ORBUNK( 16) , DB (16) 

DIMENSION COVX (3,3) 

INTEGER44 MOD ALE (3, 2) 

DATA MODALF/'ZERO* , * SET*,* • , 'REFR • , • ACTI • , *0N •/ 

REWIND 1 
REWINO 2 
REWIND 4 
MAX UNK = 16 
WRITE (6, 6001) 

6001 FORMAT! 1H1./////10X, 'CORRECTIONS TO ORBIT AND ERROR MODEL UNKNOWNS 
1*) 

C SKIP HEADER RECORD ON 2 
READ! 2 ) 

C GET CORRECTIONS AT EACH STATION 
00 120 ISTA*i,NSTA 
120 READ (2 ) (DX( I , I STA ) ,1=1,3) ,COVX 
REWIND 2 

C BEGIN PROCESSING PASSES 
150 CONTINUE 
C READ ORBIT HEADER 

READ (1) IORB,NORB,ORBNAM,IDAY, MONTH, IYR, IH, MIN, ESEC, EPOCH, CONTIN 
I F( CONTI N .EQ. ENDS IG) GO TO 700 
READ (l) DON, DDK, BN 
C GET PREVIOUS SET OF UNKNOWNS 

READ (1) NUTORB,NSTATO,NEMUNK,KSTATO , LFLG, OR BUNK , EMODEL, MODEL, 

1 I GUIDE 

WRITE( 6,6002) N0R8,0RBNAM, IDAY, MONTH, IYR, IH, MIN, ESEC , EPOCH 

6002 FORMAT (//////// /2X,A4,3X,6A8,* EP0CH=* , 13, A3, IX, 213, *H* , 13, *M* , 

1 F8.4, *S UT=MJD*,F17.9) 

COPY DDK INTO DDKM 

DO 170 I =1 ,NAXUNK 
170 DDKM( I )=DDK( I) 

DO 180 IS=1,NSTAT0 
ISTA=KSTATO( IS) 

DO 180 1=1 ,NUTORB 
DO 180 J=l,3 

180 DDKM( I )=DDKM( I )— BN ( J, I , IS )*DX( J , ISTA ) 

CALL DGMPRD (DON, DDKM, DB , MAXUNK , MAXUNK , 1 ) 

WR I TE ( 6 , 6003 ) (DB( I) , 1=1 ,NUTORB) 

6003 FORMAT ( * CORRECTION VECTOR* ,100(/6F20. 8) ) 

C UPDATE ORBIT AND ERROR MODEL UNKNOWNS 

DO 210 1=1 ,NUTORB 
210 ORBUNK( I ) =ORBUNK( I )+DB( I ) 
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C PRINT UPDATED ELEMENTS 

WRITE ( 6*6004-) I ORBUNK(I) » 1=1 .6 » 

6004 FORMAT! *0 UPDATED ORBIT ELEMENTS IN APPARENT SIDEREAL CARTESIAN 
1 C00RDINATES'/5X,'P0SITI0N!METERS) ',4X,3F16.3'/ 

1 5X, 'VELOCITY IMETERS/SEC) • ,3F 16. 61 

IFCPCODE(15).EQ.O) GO TO 220 
C PUNCH UPDATED ORBIT ELEMENTS. 

WRITE!7»7001 ) NORB»ORBNAM 

7001 FORMAT !A4,6A8) 

WRITE! 7*7002 1 IORBUNK! I) * 1=1*6) 

7002 FORMAT I 3F15 .3/3F15 .6) 

220 CONTINUE 

IF(NEMUNK.EQ.O) GO TO 230 
WRITE! 6*6005) 

6005 FORMAT! *0 UPDATED VALUE OF ERROR MODEL UNKNOWNS 1 ) 

DO 229 I =1 , NEMUNK 

MOOCOO=MODEL ! I * 1 ) 

K$TA=MODEL( 1*2) 

229 WRITE! 6*6006) !MODALF! J,MODCODJ »J=1,3) ,KORDER(KSTA ) * ! ST ANAMI J*KSTA 
1) * J=l, 5) , OR BUNK! 1*6) 

6006 FORMAT 1 5X, 3 A4, ‘FOR STATION* . 16, 2X.5A4, 2X, • = • ,F15. 3) 

230 CONTINUE 

C UPDATE PASS RECORD ON UNIT 4 

WRI TE! 4)0RBUNK, NSTATO,LFLG,KSTATO, NEMUNK, EMO DEL, MODEL, I GUIDE 
1 , NUTORB 

C RETURN TO PROCESS ANOTHER PASS 
GO TO 150 

ENTER HERE WHEN ALL PASSES HAVE BEEN PROCESSED 
700 CONTINUE 
REWIND 1 
REWIND 4 

IF! PC0DEI14) . EQ.O) GO TO 730 
C UPDATE COORDINATES OF CENTER OF MASS 
DO 710 1=1,3 

710 STAUVW ! I ,NSTA ) =STAUVWi I ,NSTA ) ♦DX! I ,NSTA) 

WRITE! 6,6007) !STAUVW!I,NSTA) ,1=1,3) ,COVX 

6007 FORMAT! ////5X, ‘UPDATED COORDINATES OF THE CENTER OF MASS'/ 

1 5X,3F15.3//5X, 'WEIGHT COEFFICIENT MATRIX'/3!5X,3F15.3/) ) 

C RESET NSTA TO ACTUAL NUMBER OF GROUND OBSERVING STATIONS 
NSTA=NSTA— 1 
730 CONTINUE 
RETURN 
END 
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FUNCTIQNMJDf DATE »MONTH» YEAR) 

COMPUTATION OF MODIFIED JULIAN DAY 
INTE6E R*2 OATE,YEAR 
DIMENSIONMONTHS! 2, 12 ) 

DAT AMONTHS/3HJ AN .0 ,3HFEB * 31 , 3HMAR , 59 ,3H APR, 90, 3HMAY, 120, 3HJUN, 151, 
13HJUL,181,3HAUG,212,3HSEP,243,3H0CT,273,3HN0V,304,3HDEC,334/ 

I 0=365*1 YEAR— 50) * C YEAR-49) /4 

00201 = 1, 12 

IF( MON TH.EQ. MONTHS! 1 , 1 ) )G0T025 

20 CONTINUE 

IFfM0NTH.LE.12) GO TO 21 
WRITE! 6,6001) MONTH 

6001 FORMAT 1 3X , 22HMON TH NAME MISPELLED ,A3) 

STOP 

21 I=MONTH 
M0NTH=M0NTHS!1,I) 

25 CONTINUE 

ID=I0+M0NTHS!2,1) 

IF! MODI YEAR* 1,4) .EQ.O.AND. I .GT.2) ID=ID+1 

MJD=ID*DATE«-33281 

RETURN 

END 
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DOUBLE PRECISION FUNCTION GSTD(l) 

COMPUTATION OF GREENWICH SIDEREAL TIME 
DUU8LEPREC IS IONT t DGST 
REAL*8 PI2/6. 28318530717958/ 

DGST=0. 2779876 16D0-H. 00273781 1910* (T-0.33282D5 ) 

C LINEAR TERM COEFFICIENT SHOULD BE 1.002737lilI906 BY A. 
DGS T=DGST-OBLE I FLOAT IJO INTI DOST))) 

GSTD=DGST*P12 

RETURN * . 

end '• ; .. . 


E. SUPP. 
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SUB ROUT INE PRENUT CDT , PAN) 

COMPUTATION OF PRECESSION AND NUTATIUN SINCE 1950.0 
C THE DIFFERENCE BETWEEN MODIFIED AND TRUt SIDEREAL 
C TIME 

C DT IS MODIFIED JULIAN DATE OF EPOCH 

IMPLICIT REAL*8 ( A— H, 0— Z ) 

DIMENSION FUNARO ( 5 ) 

REAL*4 COEFF 1 5, 131 /4*0.0, 1 .0,4*0. 0,2.0, 2*0.0, 2.0, -2.0 

1.2. 0. 0. 0.1. 0.4*0. 0,1. 0,2. 0,-2. 0,2. 0,0. 0,-1. 0,2. 0,-2. 0,2. 0,2*0. 0,2 
20, -2. 0,1. 0,2*0. 0,2. 0,0. 0,2. 0,1. 0,6*0. 0,2. 0,0. 0,2*1. 0,0. 0,2. 0,0.0, 

3. 0. 1.0. 2*0. 0,-2. 0,0. 0,-1. 0,0. 0,2. 0,0. 0,2.0/ 

REAL*4 TCCJEFI 2 , 13) /-17232? .0,-173 .7,2088 .0,0 .2 ,-12729 

1.0, -1.3,1261.0,-3.1,-497.0,1.2,214.0,-0.5,124.0,0.1,-2037.0,-0.2,6 

275.0. 0.1,-342.0,-0.4,-261.0,0.0,-149.0,0.0,114.0,0.0/ 

REAL*6 FUNCOF ( 3,5 ) /. 82251280093, .362916456847160-1,19 

113865. 0D-20, . 99576620370,. 27377785 19279D-2, -31233. 0D-20,. 031 252469 
214,-036748195691688,-668609.00-20, .97427079475 , .033663192198393 , -2 
399023. 00- 20,. 71995354167, -0. 147094228332 D-3, 43 2630. 00-20/ 
DATARPS/4. 848 1368D-6/, TP 1/6.28318530717958/ 

COSE=0. 91739033 

NT£RMS=13 

BT=DT— 15019.5 

BT2=8T*8T 

TT=BT/36525.0 

00501=1,5 

FARG=F UNCOF (1,11 ♦FUNCOF ( 2, 1 1 *8 T+FUNCOF (3,1) *BT2 
50 FUNARG ( 1 1 =(FARG— DBLE (FLOAT! I DINT ( FARG) ) ) )*TPl 

C 

0L0NG=0.0 
D080I=l,NTERMS 
ARG-0 .0 
DO60J=l,5 

60 ARG=ARG+COfcFF( J , I ) *FUNARG ( J ) 

TERM=(TCOEF( l,i)+TC0EF<2,l)*TT>*DSIN(ARG> 

DLONG=DLONG+TERH 
80 CONTINUE 

DMU=DL0NG*C0SE*0.0001 

C COMPUTE PRECESSION SINCE 1950.0 * KAPPA t OMEGA 
BY=IDT-0. 3328192305) /365.2422D0 
PRECES=( 46. 0990+1. 39E— 4*BY)*8Y 
PAN=(PRECES+DMU)*RPS 
RETURN 
END 
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SUB R0UT1NEUVWD (A » 8 , PH I , LAMDA ,H ,U , V,W ) 

C DOUBLE PRECISION VERSION OF UVM JAN 5, 1968 
DOUBLE PRECISIONPHI,LAMDA,N,E2tFAC,U,V,W,SP 
REAL*8 A,B,H 
E2=1.0— ( B/A I **2 
SP=OSIN( PHI I : 

N=A/DSQRT< 1 •0—E2*SP*SP) 

FAC=CN+H)*DCOS(PHI ) 

U=FAC*DCOS«LAMDA) 

V=FAC*DSIN(LAHDA) 

W=IN*I1.0-E2»*HI*SP 

RETURN 

END 
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SUBROUTINE OEDIT 
IMPLICIT REAL*8(A— H.O— Z) 

C0MMON/DEDITC/ALFS(50)»DEC(50) ,U<3,50) ,S(3) , D( 50) , SDC(3 ,50), SUM, 
IGAST ,STAXYZ(3,50),GQI, 

2TD.KSTATE ( 50 ) , IPASS ( 50) ,NSTE, NSUSED, KODE 
EDIT DATA BASED ON PRELIMINARY STATION POSITIONS AND DELETE BAD 
OBSERVATIONS AND BAD EVENTS. BASED ON THE DISTANCE CRITERION TD 
THIS SUBROUTINE IS DIMENSION FOR A MAXIMUM OF MAXSTE=50 STATIONS 
PARTICIPATING IN ANY ONE EVENT. ALL AFFECTED ARRAYS ARE IN 
COMMON BLOCK /DEDITC/. 

THE NUMBER OF STATIONS PARTICIPATING IN THE EVENT IS NSTE. 

THE NUMBER OF STATIONS NOT DELETED IS NSUSED. 

COMMON/STALOC/STAUWM3. 150) 

DIMENSION Q(3. 3) ,RHS 13) *0 1 ( 3 .3) .VI (3) 

MAXSTE=50 

INITIALIZE 

KODE=I 

DO 110 IS-l.NSTE 
110 IPASSI IS)=1 

IP ASS=1 MEANS THIS DIRECTION OK 

IPASS=2 MEANS THIS DIRECTION DELETED FROM EVENT 

FORM UNIT VECTORS FOR ALL DIRECTIONS IN THIS EVENT 
DO 125 I S=1 .NSTE 
STS=ALFS(IS)-GAST 
CA=DCOS(STS) 

SA=DSIN(STS) 

CD=DCOS(DEC( IS) ) 

SD=DSI N ( DEC ( IS) ) 

U( 1 , IS )=CA*CD 
U (2 . I S )=SA*CD 
U(3,IS)=SD 
125 CONTINUE 

INITIALIZE ARRAYS FOR THIS ITERATION 
130 CONTINUE 
NSUSED=0 
DO 140 1=1,3 
RHS C 1 ) =0,0 
S(I)=0.0 
DO 140 J=l,3 
Q( I » J) =0.0 
140 CONTINUE 

ACCUMULATE EQUATIONS 
DO 190 IS=1,NSTE 
I F ( IPASSI IS) .EQ.2) GO TO 190 
NSUSED =NSUSED+1 
DO 170 1=1,3 
DO 169 J=l,3 

169 QI( I,J)=U( I, JS)*U( J,1S) 

170 QIC I, I )=QI( I, I )— 1.0 
DO 175 1=1,3 

DO 175 J=l,3 

Q( I , J) =Q( I , J ) +QI ( I , J ) 
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RHS ( I ) =RHS( I H-QI ( I » J ) *STAXYZ ( J. IS I 
175 CONTINUE 
190 CONTINUE 

TEST FOR DELETION OF WHOLE EVENT 
IFINSUSED.LT.2) GO TO 420 

INVERT AND SOLVE 

THE SATELLITE POSITION S IS SELECTED IN SUCH A WAY THAT THE SUM OF 
THE SQUARES OF THE DISTANCES FROM S OF THE NON-OELETED RAYS IS MINIMIZED. 
0ET=1.0 

CALLDMINV(Q,3,DET,QI(l,i),QI (1,2) ) 

GQI =OABS( DET/DFLOAT( NSUSED) ) 

IF(GQI.LT. 1.00-4) GO TO 430 
CALL DGMPRD( Q, RHS, S, 3,3, 1 ) 

COMPUTE DISTANCE FROM S FOR EACH RAY 
ISMAX=0 
DMAX=0.0 
SUM =0.0 

DO 280 IS=1 ,NSTE 
00 270 1=1,3 
DO 269 J=l, 3 

269 QI(I,J)=U(1,IS)*U(J, IS) 

0 1 ( I , I ) =Q1 (1,1 )— 1 .0 
VI ( I ) =S( I I-STAXYZ ( I , IS) 

270 CONTINUE 
DDI=DPDOT(VI,U( 1,IS) ,3) 

DDI=DABS( DDI ) 

DI=0.0 
DO 275 1=1,3 

DI=DI+(VI ( I )-ODI*U(I , IS) )**2 
SOC ( I , IS) =VI ( I ) 

275 CONTINUE 

D( I S)=DSQRT(DI)/DD 1*206264. 80625 
IF(IPASS(IS) .EQ.2) GO TO 280 
SUM=SUM*DI 

TEST D AGAINST TD AND DELETE IF NECESSARY 
IF(D(IS) .LT.DMAX) GO TO 280 
DMAX=D ( IS ) 

I SMAX=IS 
280 CONTINUE 

IF ( OMAX.LT .TO) RETURN 
I PASS ( ISM AX) =2 

GO BACK AND MAKE ANOTHER PASS THROUGH THE DATA 
GO TO 130 
400 CONTINUE 
C DELETE WHOLE EVENT 
DO 410 IS=l »NSTE 
410 IPASS( IS)=2 
NSUSED=0 
RET RN 

420 CONTINUE 

C DELETE FOR INSUFFICIENT GOOD OBSERVATIONS 
K0DE=2 
GO TO 400 

C DELETE FOR INSUFFICIENT GEOMETRICAL SEPARATION BETWEEN OBSERVATIONS 


- 141 - 



o o o o 


SUBROUTINE RODATA 
IMPLICIT REAL*8 ( A— H»0— Z ) 

INTEGER*2 PCODE(20) . . . . . . 

COMMCW / PCODE S/PCODE 

INTEGER*^ ENDSIG/1HE/,C0NTIN,DELC0D(2)/1H ,1H*/,EC0DE 
INTEGER*2 PLUS/1H+/ 

INTEGERS I SGNP t IPHIO* I PH IM, LONGD »LQNGM» I SGNL 

1NTEGER*2 10(50) , KEY (50) , IHR ( 50 ) ,M IN (50 ) , ID AY( 50) , 1YR ( 50 > , 1R AH( 50) 
1,1RAMC50) ,ISGND(50),IDECD(50),IDECM(50),1DATC50,11> 

COMMON/OEO I TC/ALFS (50) »DE C ( 50 ) ,U(3,50) ,S(3) ,D(50) . SDC ( 3 , 50 ) , EVSUM, 
1GAS T f STAXYZ( 3,50 ) , GQI , 

2TD»KSTATE( 50) , IPASS(50) , NSTE .NSUSED , ECODE 
COMHON/NSTA/NSTA 
COMMON /STAORO/KOROER( 150) 

INTEGER STANAM,I0S*2 

COMMON/STALOC/STAU VW (3»15Q)*DATPRM(2»15) « DATNAM( 4, 15 ) * 

1STANAM ( 5 1 150 ).« 1DS( 150) , 

DIMENSION PM(3,3) ,AP(2,3) 

DIMENSION MONTH! 50) 

EQUIVALENCE ( ID ( 1 ) > IOAT (1*1) ) , < KEY ( 1 ) , I DAT( 1 , 2 ) ) , ( I HR ( 1 ) , ID AT ( 1 , 3 ) ) 
1 t ( M IN ( 1),IDAT(1,4) ),(IDAY(1),IDAT(1,5)),(IYR(1),IDAT(1,6)),(1RAH(1 
2 ) » I DAT (1*7.) ) ,(IRAM(1),IDAT(1,8) ) ,(ISGND( 1 ) , I DAT! 1 , 9 ) ) , ( I OECD ( 1 ) , ID 
3AT( 1« TO) ) » ( IDECM( 1 ) , IDAT ( 1, 11)) 

DIMENSION SEC(50),RAS(50),OECS(50) ,VARRA(.50) ,VARDEC(50) ,COVRAD( 50) 
1,DAT(50,6) ' 

EQUIVALENCE (SEC( 1) ,DAT( 1,1) ) , ( R AS ( 1 ) , DAT ( 1 , 2 ) ) , ( DECS ( 1 ) ,DAT( 1 , 3) ) , 
1(VARRA(1),DAT(1,4) ) , ( VARDEC ( 1 ) , D A T( 1 , 5 > ) , (COVR AD( 1 ) ,DAT ( 1,6 ) ) 
COMMON /OBSO/OBSD( 150) .OVOBSD 
C . , 

I F( PCODE ( 1 ).EQ. 1 ) GO TO. 3 
I F ( PCODE ( 1 ) .EQ . 7 ) GO TO 3 
RETURN 

c ' " • ■ ' ' • ' 

3 MAXSTE=50 

P I=3.14159265358D0 
SPR=2O6264.80625D0 
P I2=2.0*P I 
WPWSP=0.0 

c 

READ( 5 , 5004 ) TO, OVOBSD 
WR I TE( 6,6004 ) TD 
5004 FORMAT (F20.2,F10.2) 

6004 FORMAT ( //20X, 'TEST DISTANCE = , ,F20.2,' SECONDS OF ARC') 

WRITE! 3) TD ' ' 

C START DATA INPUT 
I EVENT=0 
KEVENT=0 

E PR =0.0 . ' 

I$=0 • - 


ENTER HERE FOR A NEW OBSERVATION 
200 IS=IS*1 

IF ( PC00E( 1 ) • EQ.7) GO TO 211 
C ENTER HERE IF THE OPTICAL DATA IS IN THE KRAKIWSKY FORMAT 

205 CONTINUE 

READ(5,1021,END=901) I D ( IS) ,KEY( I $ ) ,1HR( IS) ,MIN( IS), SEC ( IS) , 
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XIDAYUS), 

1 MONTH! IS) , IYR( IS) * IR AH ( I S ) 1 1 RAM ( I S ) .RA S( I S) , 1 SGND( IS) ,IDECD( IS). 
2IDECMI IS) .DECS! IS), VARRA! IS) .VARDECI IS) .COVRADI IS) .CONTIN 

1021 F0RMAT(I3,A1,1X,I2,I3,F9.4,I2,A3,I2,2I3,F9.4,A1, 12 , 1 3, F8 .4,2X . 
13F5.2.7X.A1) 

1022 FORMAT (14X, 14, 5 1 2 ,F6 .4, IX , 21 2.F 5.3 , Al. 2 1 2 ,F4.2 »26X » A1 ) 

IFC CON TIN. EQ. ENDS 10) GO TO 250 

DOT=OFLOAT(MJO( IDAYt IS) .MONTH! IS) , IYR! IS) ) ) 

DOT=DD T+( DFLQAT! < I HR ( I S ) *60*MIN ! I S ) ) *60 ) «-SEC ( I S) )/864.0D2 
IF( IS.LE.l) GO TO 210 

C THIS TEST SHOULD BE TRUE ONLY FOR THE FIRST CARD OF THE FIRST EVENT. 
C 

CHECH FOR END OF EVENT, ALLOWING 0.5 MS DISCREPANCY 
I F ( DABS ( DDT— EPR ) .GT.0.58D-8) GO TO 250 
C 

C ENTER HERE TO BEGIN A NEW EVENT 

C THE FIRST ENTRY OF THE EVENT SHOULD ALWAYS BE MADE WITH IS=1 

210 CONTINUE 
1DD=ID (IS) 

KSTA=KSTAID( IDD) 

IF(KSTA.GT.O) GO TC 220 

WRITE (6, 6042) I D ( 1 S ) , IHR ( IS ) .MINI 1 S) , S EC ( IS) .IDAY! IS) .MONTH! IS), 

1 IYR ( IS ) 

6042 FORMAT ( 5X, 'STATION NUMBER NOT FOUND IN INPUT L I ST • , 1 5 ,3X, 2 1 3 , 
1F8.4.3X, I3.A3.I2, 'OBSERVATION IGNORED' > 

IF! PCOOE (l).EQ.l) GO TO 205 

C ENTER HERE IF THE OPTICAL DATA IS IN THE GEOS FORMAT 

211 CONTINUE 

REA D(5, 5000, END=90i) ID (IS). IYR! IS) .MONTH! IS) , IDAY! IS) , IHR I IS) , 

1M IN IIS) .SEC! IS) . I RAH (IS), IR AM (IS), RAS! IS ) • ISGNDi IS), I OECD (IS), 
2IDECM! IS), DECS! IS) .CONTIN .VARRA ( I S) , VARDEC ( IS) .COVRAD! IS) 

5000 FORMAT! 14X , I4,5I2,F6 .4, 13 , I 2.F5.3, Al ,212, F4.2, 17X, Al , 2F3.2 , F3. 1) 

IF! CONTIN. EQ. ENDS IG) GO TO 250 
DOT=DFLOAT !M JD ! IDAY ( IS ) .MONTH! IS), IYR (IS))) 

DDT=ODT-» (DFLOAT! (THR(IS)*60+MIN( IS) )*60) +SEC (I S) )/864.0D2 
IF! IS.LE.l) GO TO 212 

C THIS TEST SHOULD BE TRUE ONLY FOR THE FIRST CARD OF THE FIRST EVENT. 
C f 

CHECH FOR END OF EVENT, ALLOWING 0.5 MS DISCREPANCY 
IFIDABSIDDT— EPR) .GT.0.58D-8) GO TO 250 
C 

C ENTER HERE TO BEGIN A NEW EVENT 

C THE FIRST ENTRY OF THE EVENT SHOULD ALWAYS BE MADE WITH IS = 1 

212 CONTINUE 
IDD=ID( IS) 

KSTA=KSTAIDI IOD) 

IF! KSTA.GT .0 ) GO TC 220 

WRITE! 6, 6042) I D ( I S ) , I HR ( I S ) ,MI N! I S) ,S EC ( I S ) , I DAY (IS), MONTH (IS), 

1 IYR (IS) 

GO TO 211 

220 CONTINUE 

219 IF(PC0DE(12) .EQ.l) GO TO 221 
1F( PCODE ( 12 ) .EQ. 2) GO TO 222 
GO TO 230 

221 VARRA! I S > =OBSD ( KST A) 

VARDEC(IS)=OBSD(KSTA) 

COVRAD (IS) =0.0 

GO TO 230 
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222 VARRA (IS)=OVOBSO 
VARDEC IlSt =0 VOS SO 
CQVRAD<IS)=0.0 
GO TO 230 
230 CONTINUE 

K ST ATE ( I S) =KSTA 
EPR=ODT 
GO TO 200 
C 

C END OF INPUT FOR THIS EVENT. BEGIN PROCESSING 
250 CONTINUE 
NST£=IS— 1 
1EVENT=IEVENT-»1 
GAST=GSTD(EPRI 
CALL PRENUT ( EPR,PAN) 

GAST=GAST+PAN 
CALL POLE (EPR.XPtYP) 

XP=XP/SPR 

YP=YP/SPR 

XP=O.ODO 

YP=O.ODO 

COMPUTE STATION POSITION IN INSTATANEOUS TERRESTRIAL SYSTEM 
PM( 1,1 )=l • 

PM( 1,2)=0.0 
PM(1,3»=-XP 
PM(2,1)=0.0 
PM(2,2)=1.0 
PM( 2,3 )=YP 
PMC 3* 1 )=XP 
PMC3,2)=-YP 
PM(3,3)=1.0 
C 

DO 270 I S=1 »NSTE 
ISGNL=PLUS 

RA=ANRADD( ISGNL, IRAHC ISI. IRAMC I S ) ,RASCI S ) ) *1 5. 0 
ALFSCIS)=RA 

DEC ( IS I =ANRADDC ISGNDl ISI , IDECDC IS) , IDECMC IS) ,DECS( IS) ) 

270 CONTINUE 

HR I TEC 3) IEVENT,NSTE,GAST,PM,EPR, 

1< Cl DAT C IS, J) .J=ltII) , MONTH C IS), COATC IS , J ) ,J = 1, 6) , ALPS ( IS) , DEC (IS ) , 
2KSTATEC IS) ,IS=1,NSTE) .CONTIN 
C TEST FOR END OF INPUT 

IF( CONTIN.EQ.ENDSIG) GO TO 700 
C PREPARE FOR NEXT EVENT 
DO 610 1=1,6 

610 DATCl, I) =DAT CNSTE* 1,1) 

MONTH C 1 ) =MONTH C NSTE+1 ) 

DO 611 1=1,11 

611 IOAT(l,n = IDAT(NSTE*l,I ) 

C RETURN TO START a NEW EVENT 

I S=1 

GO TO 210 
C 

700 RETURN 
C 

C ERROR EXITS 
901 CONTINUE 

C ENTER HERE IF END SIGNAL CARD IS MISSING FROM INPUT DATA DECK 
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SUBROUTINE RCONAP 


CONSTRAINT CODE DIRECTORY 
WEIGHTED CONSTRAINTS 

1 CONSTRAIN THE COORDINATES OF A STATION AT A PRIORI VALUES*! l.E. WEIGHT IT) 

2 IMPOSE CHORD OISTANCE CONSTRAINT*. 

3 IMPOSE RELATIVE POSITION CONSTRAINT* 

4 IMPOSE DIRECTION CONSTRAINT* 

5 CONSTRAIN THE GEODETIC LAT1 TUDE .LONG 1TUDE AND HEIGHT OF A STATION.* 

ABSOLUTE CONSTRAINT S - 

11 DEFINE THE ORIGIN OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT EQUATIONS 

12 DEFINE THE ORIENTATION OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT 

13 DEFINE THE SCALE OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT EQUATIONS 

14 COMPLETELY FIX ONE OR MORE COORDINATES OF A STATION * $ 

15 COMPLETELY FIX ONE OR MORE COORDINATES OF RELATIVE POSITION** 

*IF THE COORDINATES, RELATIVE POSITION, DISTANCE, OR DIRECTION, TO BE 
CONSTRAINED ARE NOT GIVEN, THE CONSTRAINT IS COMPUTED FROM THE 
APPROXIMATE COORDINATES OF THE STATIQNtS ) INVOLVED 

$THE DIAGONAL ELEMENTS OF THE WIEGHT MATRIX ARE 
WHICH COORDINATES ARE TO BE FIXED. A NON-ZERO CODE MEANS TO FIX 
THE COORDINATE. 

IMPLICIT REAL*8 I A— H»Q— Z ) 

INTEGER ENDSIG/1HE/,CQNTIN,STANAM , 

INTEGER*2 IDS 

DIMENSION XI(3),XJ(3),W(3,3)*D1S(3),DXB(3),DXC(3) 

COMMON /ST ALOC/STAUVW (3,150) *DATPRM( 2,15) , DATNAMI 4 , 15 ) , 

1STANAMI5.150) ,IDS( 150) 

COMMON/NSTA/NSTA/STAORD/KORDERI 150) 

DATA DPR/57 *29577951300/ 

10 RE ADI 5 , 5000, END=1000 ) KODE ,CONTI N 

5000 FORMAT C 12, 77X, Ai ) 

WRITEI3) KQDE.CQNT IN 

IF I CON TIN .EQ .ENDS IG) GO TO 1000 
IFIKODE.LE.O) GO TO 950 
IFIK0DE.GT.19) GO TO 950 

GO TO (100,200,300,400,500,600,700,800,900,950, 

11100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900), KODE 

100 CONTINUE 

REA D( 5 , 5001 ) IS 

5001 FORMAT! 1415) 

READ(5 , 5002 ) XI 

5002 F0RMAT(3D16.8) 

RE AD! 5 ,5002 ) ( W( I , 1 ) , I =1 ,3 ) 

ISTA=KSI02( IS) 

DO 110 1=1,3 

IF(XKI).EQ.O.O) XI(I ) = STAUVW(I ,ISTA) 

110 CONTINUE 

WRITE! 3) IS, 1ST A, XI, W 
GO TO 10 
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noon 


C 


C 


C 


CHORD CONSTRAINT 

200 CONTINUE 

READ! 5 f 5001 ) IStJS 
READI5 ,5002) CD.RELUNC 
ISTA=KSID2! IS) 

JSTA=KSID2! JS) 

C DC =0.0 
DO 205 1=1 #3 

D I S < I ) =S TAUVW ( 1 . I S TA ) -STAUVW i I , JST A ) 

205 CDC=CDC«-DIS! I)**2 
CDC =DSQRT(CDC) 

IF(CO.EQ.O.O)CO=CDC 

WRITE! 3) ISt ISTA, JS, JSTA, CO, RELUNC 

GO TO 10 

RELATIVE POSITION CONSTRAINT 

300 CONTINUE 

READ! 5 » 5001 ) IS,JS 

READ15 , 5002 ) OXB 

READ! 5 ,5002 ) (W! I , I ) ", 1=1 , 3 ) 

I STA=KSID2! IS) 

JSTA=KSI02! JS) 

DO 310 1=1,3 

OXC ! I ) =STAUVW! I , 1STA ) -STAUVW ( I , JSTA ) 

IF1DXB! I ) .EQ.O.O) DXB1 I ) =OXC ! I ) 

310 CONTINUE 

WRI TE! 3 ) IS, ISTA, JS, JSTA, 0XB,W 
GO TO 10 

400 CONTINUE 


DIRECTION CONSTRAINTS 
ALPHA IS LONGITUDE-LIKE ANGLE 
BETA IS LATITUDE-LIKE ANGLE 
READ! 5,5001 ) IS,JS 
ISTA=KSID2! IS) 

JSTA=KSID2! JS) 

C READ ANGLES IN DEGREES AND UNCERTAINTIES IN SECONDS OF ARC 
READ! 5 , 5002 ) ALF , BETA 
READ! 5 ,5002 ) VARA, VARBtCOVAB 
00 405 1=1,3 

405 DXC ( I ) =S TAUVW! I , ISTA ) -STAUVW ( I , JSTA) 

IF! ALF ) 412,411,412 

411 ALF=DATAN2 ! DXC ( 2 ) , DXC!1 ) ) 

ALF=ALF*DPR 

412 IF( BETA) 414, 413, 414 

413 RSCSB=DXC ( 1 ) **2*DXC{2 ) **2 
BETA=DATAN!DXC ( 3 ) /DSQRT! R SC SB ) ) 

BET A=BETA»DPR 

414 CONTINUE 

WRITE! 3) IS, ISTA, JS, JSTA, ALF, BETA, VARA , VARB, CO VAB 
GO TO 10 
C 

500 CONTINUE 

C CONSTRAINT ON GEODETICLATITUDE, LONGITUDE , AND HEIGHT 
READ! 5,5001 ) IS 
ISTA=KSID2! IS) 

IDTS=IDS! ISTA) 

C READ LATITUDE AND LONGITUDE IN DEGREES AND HEIGHT IN METERS 
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AN INPUT COORDINATE OF ZERO INDICATES THAT THE APPROXIMATE 
THE COORDINATE IS TO BE USED. 

READ«5»5002) PHI 0, FLAMO,HO 
READ UNCERTAINTIES IN SECONDS OF ARC AND METERS 
READ(5, 50021 SOP, SDL, SDH 

AN INPUT UNCERTAINTY OF ZERO INDICATES THAT A ZERO WEIGHT 
CALL UVWTG2 ( S TAUVW ( 1 , I S T A ) ,D ATPRMC 1 , I DTS > ,PH I , FLAM ,H ) 
IFIPHIO.EQ.O.O) PH IO=PHI *DPR 
IFf FLAMO.EQ.O.O) FLAMO=FLAM*DPR 
IF(HO.EQ.O.O) HO=H 

WRITE! 3) IS,ISTAfI DTS ,PH 1 0, FLAMO ,H0 , SOP, SDL, SDH 
GO TO 10 


600 CONTINUE 
700 CONTINUE 
800 CONTINUE 
900 CONTINUE 
GO TO 950 


INNER ADJUSTMENT CONSTRAINTS 
1100 CONTINUE 
1200 CONTINUE 
1300 CONTINUE . 

1600 CONTINUE 

GO TO 10 

C 


1400 CONTINUE 
C FIX A STATION 
GO TO 100 
C 

1500 CONTINUE 
GO TO 300 


C 


1700 CONTINUE 
1800 CONTINUE 
1900 CONTINUE 
GO TO 950 

950 WR I TEI 6,6095 ) KODE 

6095 FORMAT! 'OILLEGAL CONSTRAINT CODE IN CONAP IGNORED', I5» 
GO TO 10 


C 


1000 CONTINUE 
REWIND 3 
RETURN 
END 


VALUE OF 


S TO BE USED. 
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CONSTRAINT CODE DIRECTORY 


WEIGHTED CONSTRAINTS 

1 CONSTRAIN THE COORDINATES OF A STATION AT A PRIORI VALUES*! I. E.WE1GHT I T » 

2 IMPOSE CHORD DISTANCE CONSTRAINT*. 

3 IMPOSE RELATIVE POSITION CONSTRAINT* 

4 IMPOSE DIRECTION CONSTRAINT* 

5 CONSTRAIN THE GEODETIC LATITUDE, LONGITUDE AND HEIGHT OF A STATION.* 
ABSOLUTE CONSTRAINTS 

11 DEFINE THE ORIGIN OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT EQUATIONS 

12 DEFINE THE ORIENTATION OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT 

13 DEFINE THE SCALE OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT EQUATIONS 

14 COMPLETELY FIX ONE OR MORE COORDINATES OF A STATION * $ 

15 COMPLETELY FIX ONE OR MORE COORDINATES OF RELATIVE POSITION** 

*IF THE COORDINATES, RELATIVE POSITION, DISTANCE, OR DIRECTION, TO BE 
CONSTRAINED ARE NOT GIVEN, THE CONSTRAINT IS COMPUTED FROM THE 
APPROXIMATE COORDINATES OF THE STATION(S) INVOLVED 

$THE DIAGONAL ELEMENTS OF THE W MATRIX ARE USED AS CODES TO INDICATE 
WHICH COORDINATES ARE TO BE FIXED. A NON-ZERO CODE MEANS TO FIX 
THE COORDINATE. 

SUBROUTINE PSOLN 
IMPLICIT REAL*8 ! A— H,D— Z I 
COMMON/NSTA/NSTA/STAORD/KORDER! 1501 
INTEGER*2 L,LSOLVE,IDS 
INTEGER STANAM 

COMMON/STALOC/STAUVWl 3,150) ,DATPRM(2, 15) , DATNAMI4, 15 ) , 

1 STANAM (5,150),IDS(150) 

COMMON/WPW/WPW»XPU, IDEGF, IFSTA 
INTEGER*2 PCODE 
COMMON /PCODES/PCODE120) 

DIMENSION AOX! 3) 

DIMENSION EIG(6),EVt3, 3), C0VX13, 3) ,VARX(3, 40) 

REAL*8 LAM 

DIMENSION Q(3,3,40) ,DELCOV( 3,3 ) ,UNC (3 ) 

DIMENSION DX( 3,40) ,UNCE ( 3, 40 ) 

DIMENSION RLX( 3,3) ,RL0!3,3) ,RXD<3,3) 

EQU I VALENCE (RXD!1,1),EV(1,1)) 

L0C!K)=!K*!K*1) )/2 
REWIND 2 

WRITE! 6,6001 ) WPW.XPU 

6001 FORMAT I /10X , • W' * PW=' , D16.8, * -X • 'U=* , DI6.8 ) 

VPV=WPW-XPU 

IDEGF=IDEGF-3*NSTA 
VARO=VPV/DFLOAT! IDEGF ) 

SIGO=DSQRT( VARO) 

WRITE! 6, 6002) IDEGF, VPV, VARO ,SIGO 

6002 FORMAT! 1H1/////////T50, 'NUMBER OF DEGREES OF FREEDOM =• , I 8/1H0.T38 
1, 'QUADRATIC SUM OF ALL THE RESIDUALS !VPV) =',F13.4/1H0,T55, 

2 ' VAR IANC E OF UNIT WEIGHT = ' , FI 3 .4/1H0, T45 , 

3 • STANDARD DEVIATION OF UNIT WEIGHT =', F13.4) 


C 
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READ(2 ) ( (VARX( 1, 1 SIA),l=i,3),I STA=1,NSTA) 

DO 80 1STA=1 fNSTA 
DO 80 1=1,3 

IF(VARX(I,ISTA).LE.O.O) GO TO 79 
VARX(I , ISTA ) =DS8RT ( VARX ( I , ISTA) ) 

GO TO 80 

79 VARXd ,ISTA)=0.0 

80 CONTINUE 

DO 200 ISTA=1 ,NSTA 

READ(2) (DX( I, I STA) ,1=1,3) , C( (0(1 ,J,JSTA) ,1=1, 3), J= 1,3), 
1JSTA=1STA,NSTA) 

IF( ISTA— 2*( ISTA/Z) .EQ . l.OR .PCODE ( 20 » . EQ. 1 ) WRI TE ( 6, 6011 ) 

6011 FORMAT ( 1H1 ) 

I OAT= I DS ( ISTA) 

HR I TE( 6,6003) KORDER ( I STA ) , ( STANAM ( I , I STA ) , I =1 ,5 ) 

1 , IDAT, (DATNAM( I , IDAT) , 1=1 ,9) 

6003 FORMAT (3(/)»*0STATI0N NUMBER - * , 1 8 , 10X ,9A9* A2 , 5X, 

1 * ELLIPSOID* , I9,9X ,9A8 ) 

HR I TE ( 6,6010 ) 

6010 FORMAT ( , 0 , »25X, , X , »15X, , Y , *15X» , Z*»2IX»' LAT . ' , 12X , »LONG.I*E) 

1ELL. HT.') 

CALL UVHTG ( STAUVH ( 1 , I STA ) ,OATPRM(l , I DA T ) , PHI , L AM,H) 

CALL DANG ( PHI ,ISGNP,IOEGP,IMINP«SECP) 

CALL DANG (LAM, ISGNL, IDEGL, I M INL , SECL > 

HR I TE ( 6,6005) ( STAUVH( I , I STA ) , I = 1 , 3 ) , I SGNP , IDEGP , I MI NP ,SECP, 
1ISGNL, IDEGL, IMINL, SECL, H 

6005 FORMAT ('OPREL. COORD. - • ,3F16 .4 , 7X, 2( 3X , Al, 2 13, F8. A ) , F12 . 9) 

00 100 IK=l»3 

100 ADX (IK )=DX( IK, ISTA) 

CALL OELUADX ,0(1, 1,1 STA) ,PHI,LAM,H, 

1 DATPRM( 1, IDAT) , DP ,OL,DH , DELCOV ,RLX > 

DO 120 1=1,3 
DO 110 J=l,3 

DELCOV ( I , J) =DELCOV ( I , J ) *VARO 
110 COVX(I,J)=Q(I,J,ISTA)*VARO 
UNC II) =VARX ( I , ISTA ) *S IGO 
IF(DELC0V(I,I).GT.0.0) GO TO 115 
UNCE(I,ISTA)=0.0 
GO TO 116 

115 CONTINUE 

UNCE(I , ISTA )=DSQRT (DELCOV ( I, I ) ) 

116 CONTINUE 

STAUVH ( I,ISTA)=STAUVH(I,ISTA)+DX(I,ISTA) 

120 CONTINUE 

CALL OANG(DP, ISGNP,IOEGP, IMINP,SECP) 

CALL DANG (DL» ISGNL , IDEGL, IMINL , SECL ) 

DO 125 1=1,3 

I F ( I.LT.3) UNCE( I , ISTA )=UNCE ( I , ISTA ) *206269 , 8062 
DO 125 J=1 ,3 

IF ( I.LT.3) DELCOV ( I, J ) =DELCOV( I , J ) *206 269 .8062 
I F ( J.LT.3 ) DELCOV ( I ,J ) =DELCOV( I ,J > *206269.8062 
125 CONTINUE 

HR ITE( 6,6006) (DX( I , ISTA) , 1=1,3 ) 

1, 1 SGNP, IDEGP, IMINP,SECP, I SGNL, I DEGL, IM INL, SECL, DH 

6006 FORMAT ( 'OCORRECTIONS - ' ,3F16 .9, 7X, 2( 3X , A 1 , 21 3, F8 .9 ) , F12 .9) 
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CALL UVWTGI STAUVW ( 1, ISTA ) ,DATPRMI1»IDAT) ,PHI ,LAM»H> 

CALL DANGIPH1 , ISGNP, IDEGP , IM1NP ,SECP ) 

CALL DANG ( LAM» I SGNL, I DEGL ,IMINL*SECL ) 

MR I TE( 6,6007) ( S TAUVWI I , I STA ) , 1 = 1 , 3) 

It I SGNP »IDEGP,IMINP,SECP*I SGNL, IDEGL»IMINL*SECL,H 

6007 FORMAT! '0ADJ. COORO. - • ,3F16. 4, 7X , 2 1 3X , A 1 , 21 3, F8 .4 ) , F12 .4) 

I F ( PCOO El 17) . EQ. 1 ) WR I TE I 7, 7001 ) K ORDER II STA ), I STAUVW ( 1 1 1 STA ) , 

1 1=1,3), tCOVXtl.l), 1=1,3) 

7001 FORMAT! I A , AX , 3F16 .6/3F10 .3 ) 

I F I PCOO E 1 18) .EQ.l) WR I TE 1 7, 5005 ) KORDER I ISTA ) , IOAT, 

1 I STANAM ( I»ISTA)»I=1,5),ISGNP»IDEGP,IMINP«SECP»IDEGL»1MINL» SECL»H» 
2IUNCEI I, ISTA), 1=1, 3) 

5005 FORMAT I I A, 1 2 , AAA ,A2»A1,2 1213, F6 .A) , F 1 0. 2, 2F3 . 1 , F3 .0 ,7X, A1 ) 

WRITE I 6,6008) IICOVXll.J ) , J=1 , 3 ) , I DELCOVI I , J ) , J= 1, 3) , 1 = 1 ,3 ) 

6008 FORMAT! 'OVAR I ANCE-COVAR I ANCE MATRIX OF THE STATION POSITION'// 

131 1 AX ,3F16.6, 10X,3F16.6/) ) 

WR I TE I 6,6009 ) UNC , IUNCE 1 1 , I STA ) , I = 1 , 3 ) 

6009 FORMATI 'OSTAND- DEV. , 3F 16. A, 10X ,3F16 . A > 

C 

IFIPCODEI 19) .NE.l) GO TO 150 
C COMPUTE EIGENVALUES 

WR I TE 1 6 ,6100 ) 

6100 FORMATI '0DIRECT10NS OF EIGENVECTORS AND SQUARE ROOTS OF EIGENVALUE 
IS OF VARIANCE-COVARIANCE MATRIX -• /T 20, • LATITUDE • ,TA0, • LONGI TUDE» , 

2 T60, 'ELEVATION', T80, 'AZIMUTH' ,T100, 'AXIS LENGTH') 

NB=0 

DO 135 J=1 ,3 
00 135 1=1, J 
N6=NB+1 

135 EIGINB )=COVX| 1,J) 

CALL DEIGENIEIG,EV,3,0) 

CALL 0GMPRD|RLX.RXD,RLD,3,3,3) 

DO 1 AO 1=1,3 

PHI=DATANIEVI3,I ) /DSQRTI E V 1 1 , I )**2+EVl2,I )**2> ) 

LAM=DATAN2 I EVI2 , I ) , EVI 1 , 1 1 ) 

ELEV=DATAN IRLDI 3 , I ) /DSQR T( RLD 1 1 , I ) **2+R LD 12 , 1 »**2 ) ) 
AZ=DATAN2IRLDI2,I) ,RLD(1,I)) 

CALL DANGIPHI, ISGNP, IDEGP , IM INP ,SECP ) 

CALL DANG (LAM, IS&NL, I DEGL ,IMINL,SECL) 

CALL DANG (ELEV»ISGNEL,IDEGEL,IMINEL, SECEL) 

CALL DANG I AZ , I SGNAZ, IDEGAZ, IMINAZ, SECAZ) 

EVAL=EIGILCiCI I ) ) 

IFIEVAL.LE.O.O) GO TO 137 
EVAL=DSQRT|EVAL) 

GO TO 139 
137 EVAL=0 .0 
139 CONTINUE 

WRITE I 6,6101 ) ISGNP, IDEGP, I MI NP ,SECP, I SGNL, I DEGL , I M INL , SEC L, 

1 I SGNEL, IDEGEL, 1MINEL ,SECEL,ISGNAZ, 1DFGAZ , I MI NAZ, SECAZ , EVAL 

6101 FORMAT 1 1H0 ,14X,4(A1,2I3,F8.4,5X),F12.4) 

1A0 CONTINUE 

150 CONTINUE 
C 

IFIPCODEI 20) .NE.l) GO TO 200 

C COMPUTE CORRELATION COEFFICIENTS 

WR I TE I 6 ,6105 ) 

6105 FORMATI 1H0.15X, *3X3 WEIGHT COEFFICIENT MATRI CE S' , A3X , 'CORREL ATI ON 
1C0EFF I CIENTS ’ /1H0, 2 1 25X, • X* » 15X » • Y * »15X» * Z * ) ) 
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DO 160 JSTA=1STA,NSTA 
DO 155 1=1,3 
DO 155 J=1 , 3 

DENOM=VARX< I , I STA ) *VARX ( J , JSTA) 

IF(DENOM) 154,154,153 

153 EV< I,J)=0(I , J,JSTA)/DENOM 
GO TO 155 

154 EV< 1,J1=0.0 

155 CONTINUE 

WRITE (6, 6 106) KCRDER(ISTA), KORD ER (JSTA) 

6106 FORMAT ( 1HG , 5X ,* . STA. NO.*, 15,* WITH STA. NO. * , 15 ) 

WR 1 TE ( fc ,6107 ) ((0(1, J, JSTA), J=1,3),(EV( I , J ) , J=1 , 3 ) , 1 =1 , 3 ) 

6107 FORMAT ( 14X»3F16.6» 10X»3F16.6) 

160 CONTINUE 

200 CONTINUE 

C PRINT OUT SUMMERY OF RESULTS 

I F ( PCODE ( 10 ) . EQ. 0 ) GO TO 300 
WRITE! 6,6011 ) 

DO 300 ISTA= 1 ,NSTA 
DO 219 1=1,3 

219 UNC ( I ) =VARX ( I , I STA )*SIGQ 

WR I TE ( 6,6108 ) KQRDER ( ISTA ) , ( STA NAM ( I , I STA ) , I =1 ,5 ) 

I DAT= I DS ( I STA ) 

JD=PCODE ( 10 ) 

GO T0( 220,240,260,260) ,JD 

220 WR I TE ( 6 , 6 109 ) ( DX ( I , I STA I , I = 1 , 3 ) ,UNC 
GO TO 300 

240 WR I TE( 6 ,61 10 ) ( S TAUVW( I , I STA ) , I =1 , 3) ,UNC 
GO TO 300 

260 CALL UVWTG(STAUVW( 1, ISTA) , OATPRM( 1 , 1 DAT ) , PHI, LAM, H) 

CALL DANG ( PHI , 1 SGNP , I DEGP, I M INP, SEC P) 

CALL DANG ( LAM, I SGNL , I DEGL , I M INL, SEC L) 

IF ( PCODE (10).EQ.4) GO TO 270 

WRITE (6,6111) I SGNP, IDEGP , l M I NP , SECP , I SGNL , I DE GL , I M I NL , SECL , H , 

1 ( UNCE ( I, ISTA), 1=1, 3) 

GO TO 300 

270 WRITE! 6,61 12) ( S TAUVW( I , I STA ) ,1 = 1,3) , I SGNP , I DEGP , I MI NP , SECP , IDEGL, 
1IMINL, SECL, H,UNC,(UNCE( I , ISTA) ,1=1,3) 

6108 FORMAT! I 8, 1X»4A4,A2 ) 

6109 FORMAT ( 1H+ , 27X, 3F 10 .4, /28X * 3F10.4/) 

6110 FORMAT ( 1H+ , 27X , 3F 16 .4./28X , 3F 16 . 4/) 

6111 FORMAT (1H+,27X,2(3X, A 1 , 2 13 , F8 . 4) , F 12.4, /38X , F 6 .4 , 10 X , F 8 . 4, F 12 .4/) 

6112 FORMAT ( 1H+ , 27X, 3F16 . 4, 3X, A 1 , 2 1 3 , F8 .4 , 3X , 2 1 3, F8 .4,F 12 .4 , /28X, 

1 3F 16.4,2! 10X,F8.4),F12.4/) 

300 CONTINUE 
RETURN 
END 
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SUBROUTINE C0NAP1 ( KODE) 

CONSTRAINT CODE DIRECTORY 
WEIGHTED CONSTRAINTS 

1 CONSTRAIN THE COORDINATES OF A STATION AT A PRIORI VALUES*! I .E .WE IGHT IT) 

2 IMPOSE CHORD DISTANCE CONSTRAINT*. 

3 IMPOSE RELATIVE POSITION CONSTRAINT* 

A IMPOSE DIRECTION CONSTRAINT* 

5 CONSTRAIN THE GEODETIC L A TI TUDE , LONG I TUDE AND HEIGHT OF A STATION.* 

IMPLICIT REAL*b!A-H,0-Z) 

1NTEGER*2 L,LSOLVE,IDS 
INTEGER CONTI N» STANAM 

COMMON/STALOC /STAUVW (3, 150) ,DATPRM{2,15) ,DATNAM!A, 15 ) t 
1STANAM!5,150),1DS!150) 

C OMMCIN /NS TA/NSTA»N BLOCK 
COMMON/STAORD/KORDER! 150) 

COMMON /NORMEQ/REDN13, 3, 2A85) ,U13,70) ,L«2Ab5) ,LSOLVE 
COMMON /WPW/WPW »XPU * IDEGF, IFSTA 

DIMENSION XI!3),XJ13),W!3,3) , D I SI 3 ) , DX 6 ( 3 ) ,DXC (3 ) 

EQUIVALENCE ( X 1 1 1 ) »DXB < 1 ) ) , I XJ III , DXC! 1 ) ) 

DIMENSION G<2,3) 

DATA SPR,DPR/20626A. 80625, 57. 295779513/ 

L0CIK)=(K*(K*l))/2 
6150 FORMAT !10X,3D16. 8) 

GO TO 1100, 200, 300, AGO, 500,600, 700, 800,900), KODE 
100 CONTINUE 

READ ( 3 ) IS, ISTA,X i,W 
NB=LOC ! I STA ) 

K=0 

DO 110 1=1,3 

DIS!1)=XI(I ) — STAUVW ( I , I STA ) 

REDN! I ,I,NB)=RFON! I, I ,NB ) +W ! I, I ) 

U< I , I S T A ) =U ! I , I S T A ) +W ! I , I >*DIS< I) 

IF iW! I ,1 ) .EQ.O.O) GO TO 110 
K=K+1 

WPW=WPW+DIS( I )*W( I ,1 )*DIS< I ) 

IDEGF= IDEGF+1 
110 CONTINUE 

IF! K.EQ.3) L (NB ) =L IN8 ) *1 

WRITE 16, 6100) I S, ! STANAM II, I STA), 1 = 1,5), XI, !W! I, I), I =1,3) 

6100 F0RMAT!///15X,*A PRIORI CONSTRAINT ON STATION* ,I5,2X,5AA/ 

1 15X , * COORD INATES*,3Flb.2/15X,*WE IGHTS* ,6X,3F16.A) 

GO TO 10 

C CHORD CONSTRAINT 

200 CONTINUE 

READ (3) IS, ISTA, JS, JSTA ,CD , RE LUNC 
IF! JSTA.GE. ISTA) GO TO 210 
C SWITCH SUBSCRIPTS IF NECESSARY 
NB= ISTA 
I STA=JSTA 
JSTA=N8 
210 CONTINUE 
CDC =0.0 
DO 205 1=1,3 

DISH )=STAUVW! I, I STA) -STAUVW 1 1, JSTA) 
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205 CDC=CDODIS< I ) **2 
C0C=DSQRT(CDC) . 

00 215 1=1,3 
215 DISCI ) =01 S(I J/CDC 
CDD=CD— CDC 
WCD = I R ELUNC /CD ) **2 
I B=LGC ( I STA ) 

JB=L0C( JSTA) 

NB = L0C (JSTA— 1J+ISTA . 

00 220. 1=1*3 

U< I ,ISTA)=U( 1,1STA)+0IS(I )*WCD*CD0 
U(I,JSTA)=U(I*JSTA)-DIS(I )*WCD*CDD 
DO 220 J=1 , 3 
TERM=DIS(I )*WC0*D1S(J) 

REDNI I tJ , IB ) =REDN( I,J,1B)*TERM 
REDNI I ,J, JB)=REDN( I,J,JB)+TERM 
RE ONI I »J»NB)=REDN( I *J*NB)-TERM 
220 CONTINUE 

WR I TE( 6,6200 » KORDER I 1STA ) , I ST ANAMI 1 , 1 STA ) , I =1 , 5 ) , KORDERI JSTA) , 

1 ( ST ANAMI I , JSTA ) ,1=1, 5) , CD ,R ELUNC 

6200 FORMAT! ////15X, 'CHORD DISTANCE CONSTRAINT IMPOSED BETWEEN STATION* 
1*15, 2X»5A4/53X*' AND STATI0N'*I5,2X*5A4/15X»' CONSTRAINED DISTANCED 
2.F16.2/15X, 'THE WEIGHT IS COMPUTED FROM A RELATIVE UNCERTAINTY OF 
30NE PART IN' ,F 16.2 ) 

WRITE I 6,6150) CDD 
L! I B I =L 1 1 B ) +1 
L I J B) = LI JB ) ♦ 1 
L(NB)=L(NB)+1 
WPW=WPW+ COD*WCD*CDD 

1 DEGF=IDEGF«-1 
GO TO 10 

C RELATIVE POSITION CONSTRAINT 

300 CONTINUE 

READ (3) IS, ISTA, JS, JSTA,DXB,W 
1 B=LOC ( 1 STA I 
JB=LQC ( JSTA) 

NB=LOC (JSTA— 1I+1STA 

I F ( 1ST A .GT • JSTA I NB = LOC( ISTA-1I+JSTA 
DO 310 1=1,3 

DXC 1 1 ) =STAUVW 1 1 , I STAI-STAUVW 1 1 , JSTA) 

D I S ( I ) =DXB ( 1 )— OXC ( I ) 

IF(W(1,I).EO.O.O) GO TO 310 
WPW=WPW+D1SII)*W( I,1)*D1SI1) 

I DEGF=IDEGF+ l 

U( I ,ISTA)=U< I.1STAI+WI I, I l*DIS(I) 

U( I ,JSTA)=U( I,JSTA)-W( I, I i*Dism 
REDNI I , 1 , IB ) =REDN( I , I , 1 B ) +W I I , I ) 

REDNI I ,1 ,JB)= REDNI I , 1 , JB ) +W I I, I ) 

REDNI I ,I,NB)=REDN( I, I,NB)-W( I, I ) 

310 CONTINUE 

LI IB)=L( 1B)+1 
L I J B ) =L I JB ) +1 
L I NB) =L I NB ) ♦ I 

WRITE I 6,6 300 ) KORDER ( I STA ) , I STANAM I I , ISTA) , 1 = 1,5) , KORDER I J ST A ) , 

II ST ANAMI I , JSTA) , 1= 1 , 5 ) , DX B , I W I I , I > , I =1 , 3 ) 

6300 FORMAT I // //15X, 'RFLATIVE POSITION CONSTRA INT» / 15X ,' BETWEEN STATION 
1 ' , I 5,3X»5A4» • AND ST AT I ON* , 1 5 ,2X, 5A4//15X, 'RELATIVE COORDINATES 
2 ARE VI 5X,3F 16.2// 1 5X , 'WEIGHTS ARE'/17X ,3F16.A) 
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WR 1 TE ( 6 ,6 1 5 0 ) (DIStI » ,1 = 1,31 
GO TO 10 
400 CONTINUE 


C 

C 

C 


DIRECTION CONSTRAINTS 
ALPHA IS LONGITUDE-LIKE ANGLE 
BETA IS LATITUDE-LIKE ANGLE 
READ (3) IS.ISTA, JS.JSTA, ALF , BETA , VA RA , VARB.COVAB 
WRITE (6,6400) KORDER ( ISTA ) , ( STANAM { I , I STA ) , 1 =1 , 5 ) t KORDER ( J STA ) , 
i(STANAM( I.JSTA) , 1=1,6) , ALF,BETA, VARA, VAR B,COVAB 
6400 FORMAT! ////15X, 'DIRECTION CONSTRAINT IMPOSED BETWEEN STATION*, 
1I5,2X,5A4,/48X, 'AND STATI ON * , I 5 , 2X , 5 A4/15X, * ANGLES (DEGREES ) * »4X 
22F16.8/15X, • UNCER TA INTI ES ( SECONDS) *,3F16.3) 

DO 405 1=1,3 

405 DXC (I)=STAUVW(I,ISTA)-STAUVW(1,JSTA) 

RSCSB=DXC( 1 )**2+DXC(2)**2 
TA=DXC (2) /DXC( 1) 

CSA=1.0/(1.0+TA*TA) 

RCB=DSQR T( RSCSfa ) 

T8=0XC ( 3 ) /RCB 
CSB=1.0/(1.0+TB*TB) 


* 


C 


c 


c 


c 


A0=DATAN2(DXC(2) ,DXC( 1) ) 
DIS(1)=ALF/DPR-A0 
PI=180. O/DPR 

IF(D1S(1) .GT.PI) D1S(1)=DIS(1)-2.0*PI 
1F(DIS(1).LT.(-PI) ) DIS(1)=DIS( 1)+2.0*PI 
B0=DATAN(DXC(3)/RCB) 

D I S ( 2 ) =BET A/DPR— BO 
WRITE! 6,6 150 ) D I S ( 1 ) , D l S( 2 ) 

G ( 1,1) =CSA*T A/DXC ( 1 ) 

G ( 1 ,2 ) =— CSA/DXC ( 1 ) 

G ( 1 , 3 ) =0.0 

G(2,1)=CSB*TB*DXC(1)/RSCSB 
G(2,2)=G(2,1)*TA 
G ( 2 ,3) =— CSB/RCB 

VARa=(VARA/SPR)**2 

VARB = ( VARB/SPR) **2 

OET =VARA*VARB— C0VAB*C0VAB 

W( 1,1)=VARB/DET 

W(2,2)=VARA/DET 

W( 1 ,2) =— COVAB/DET 

W ( 2 , 1 ) =W (1,2) 

1B=L0C(ISTA) 

JB=LOC(JSTA) 

NB = LOC( JSTA-D + ISTA 

IF( ISTA.GT.JSTA) NB=LOC ( I STA-1J ♦ JS TA 

DO 445 1=1,3 

SUM=0.0 

DO 443 11=1,2 

DO 443 J J = 1 , 2 

443 SUM=SUM+G( 1 1,1)*W< II,JJ)*DIS( JJ ) 

U( I ,ISTA)=U( l, I STA) -SUM 
U( 1 ,JSTA)=U(I,JSTA) ♦SUM 
DO 445 J = 1 * 3 
SUM=0 • 0 
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00 444 11=1,2 

DO 444 JJ=1 ,2 

444 SUM=SUM+G< 1 1 , I )*W( II , JJ)*G< Jj , J J 
REDNU ,J,16)=REDN( I,J,IB)+SUM 
R£DN( I ,J » JB ) =REDN ( I * J * JB ) + SUM 

I F C 1STA.GT.JSTA) GO TO 446 
REDN( I » J *NB ) =REDN ( 1 , J , NB ) -SUM 
GO TO 446 

446 REDN< J, I ,N6) =REDN( J, I,NB)-SUM 

445 CONTINUE 

DO 450 11=1,2 

IFIW(lItin.EQ.O.O) GO TO 450 

L ( I B ) =L ( 1 6 ) +1 

L( JB)=L< JBI+l 

L(NB)=L(NB)+1 

IDEGF=I DEGF+1 

DO 450 JJ=1 ,2 ' 

WPW=WPW+DI S ( II ) *W ( II,JJ)*DIS(JJ) > 

450 CONTINUE 
GO TO 10 
C 

500 CONTINUE 

READ (3) IS,1STA, I DTS »PH 1 0, FLAMO , HO » SDP ,SDL» SDH 

HR I TE ( 6,6500 I I S , ( ST ANAM (I , I ST A ) , I = 1 ,5 > , PH 1 0 ,F LAMO ,H0 , 1 DTS , 

1 (DATNAMI I , IDTS) ,1 =1,41 , SDP, SDL, SDH 
6500 FORMAT ( ////15X,*THE ELLIPSOIDAL COORDINATES (L AT. , LONG. , HE 1GHT ) OF 

1 ST AT ION • , 17 , 3X , 5A4/ 15X , * ARE CONSTRAINED AT* //2IF20.9, • DEGREES 1 ) , 

2 F20. 3, ' METERS' //15X,*0N DATUM* , 15 ,3X,4A8// 

3 15X, 'THE WEIGHTS FOR THESE CONSTRAINTS ARE COMPUTED FROM OBSERVAT 
4I0NAL STANDARD DEVIATIONS OF*// 

5 2IF20.3,' SECONDS*) ,F20. 3, * METERS*) 

CALL UVWTG3(STAUVH(l,ISTA),DATPRM(l, IDTS), PHI, FLAM, H) 

IB=LOC 1 1 STA ) 

SP=DSIN( PHI ) 

CP = DC0S I PHI ) 

SL=DS I N (FLAM ) 

CL=DCOS (FLAM ) 

AE=DATPRMI1, IDTS) 

E2 = 1.0 — C DATPRM ( 2 , 1DTS)/AE)**2 
EW=DSORT( 1.0-E2*SP*SP) 

EN= AE/EW 

EM=AE* ( l .0— E2 ) /EW**3 

1 Ft SDP. EQ. 0.0) GO TO 510 
WT=1.0/<SDP/SPR)**2 
DXG(1 ) =-SP*CL/(EM+H) 

DXB(2) =-SP*SL/lEM+H) 

DXB ( 3 ) = CP/ ( EM + H ) 

D I SC=PH1 0/DPR— PH I 
ASSIGN 510 TO J5 
GO TO 550 
510 CONTINUE 

IF( SDL. EO. 0.0) GO TO 520 

WT=1.0/(SDL/SPR>**2 

DFNOM= ( EN+H ) *CP 

OXB ( 1 ) =— SL/DENOM 

OXB ( 2 ) = CL/DENOM 

DXB ( 3 ) =0 . 0 

D I S C=F LAMO/DPR— FL AM 
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ASSIGN 520 TO J5 
GO TO 550 
520 CONTINUE 

IF< SDH. EO. 0.0) GO TO 560 

WT=1.G/SDH**2 

DXB(i)=CP*CL 

DXB (2 1 =CP*SL 

OXB < 3 ) =SP 

D I SC=HO— H 

HR I TE( 6,6150) DISC 
ASSIGN 560 TO J5 
GO TO 550 
550 CONTINUE 

00 555 1=1,3 

U ( I » IS TA ) =U ( I » I STA ) +DX6( 1 )*WT*01SC 
DO 555 J= 1 , 3 

REDN( I , J , I B I =RE DN ( I ,J, IB J+DXBI 1 )*WT*DXB{ J) 
555 CONTINUE 

L ( IB)=L( 1B) + 1 
IDEGF=IDEGF+1 
WPW=WPW+DISC*WT*DI SC 
GO TO J5, (510,520,560) 

560 CONTINUE 
GO TO 10 

600 CONTINUE 
700 CONTINUE 
800 CONTINUE 
900 CONTINUE 
10 CONTINUE 
RETURN 
END 
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SUBROUTINE C0NAP2 < K0DE2 » 

ABSOLUTE CONSTRAINTS 

11 DEFINE THE ORIGIN OF THE COORDINATE SYSTEM f BY INNER ADJUSTMENT EQUATIONS 

12 DEFINE THE ORIENTATION OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT 

13 DEFINE THE SCALE OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT EQUATIONS 

14 COMPLETELY FIX ONE OR MORE COORDINATES OF A STATION'* 

15 COMPLETELY FIX ONE OR MORE COORDINATES OF RELATIVE POSITION** 

* I F THE COORD 1 N AT ES ,R EL ATI VE POSITION, DISTANCE, OR DIRECTION, TO BE 
CONSTRAINED ARE NOT GIVEN, THE CONSTRAINT IS COMPUTED FROM THE 
APPROXIMATE COORDINATES OF THE STATION! S> INVOLVED 

* THE DIAGONAL ELEMENTS' OF THE W MATRIX- ARE USED AS CODES TO INDICATE 
WHICH COORDINATES ARE TO BE FIXED. A NON-ZERO CODE MEANS TO FIX 
THE COORDINATE. 

PROCESS A PRIORI CONSTRAINTS ON, AND BETWEEN, STATIONS 
IMPLICIT RE AL*8 ( A— H »0— Z ) 

INT £GER*2 L,LSOLVE,IDS 
INTEGER END S IG/1HE/, CONTI N, STAN AM 

COMMON/STALOC/STAUVW! 3,150) , DATPRM ( 2 , 15 ) , DATNAM! 4, 15 ) , 

1ST AN AM (5,1 50), IDS! 150) 

COMMON /NSTA/NSTA,NBLOCK 
COMMON/STAORD/KORDER! 150) 

C0MM0N/NCRMEQ/REDNI3 ,3,2465 )«U{ 3* 70)’, L (2485 ) » LSOL VE 1 ' 

COMMON /WPW/WPW ,XPU * IDEGF , IF ST A 

DIMENSION XI! 3), XJ( 3), W( 3,3) ,D I S ! 3) , DXB { 3 > ,DXC ( 3 ) 

EQUIVALENCE (X I ,DX6) , ( X J , DXC ) 

DIMENSION G( 2 ,3 ) ~ 

DATA SPR/206264. 80625/ 

LOC (K ) = ( K* ( K*l ) ) /2 
MAXBLK=70 

ABSOLUTE: CONSTRAINTS THAT REQUIRE EXPANSION OF THE NORMAL EQUATION 
MATRIX BY THE ADDITION OF LAGRANGE MULTIPLIERS 

K0DE2 IS K0DE-10 " - 

GO TO ( 1100,1200, 1300,1400, 1500,1600,1700, 1800,1900) ,K0DE2 
C 11 DEFINE THE ORIGIN OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT EQUATIONS 
1100 CONTINUE 

ASSIGN 1110 TO JRTN 
GO TO 960 
1110 CONTINUE 

00 1120 I STA=1 ,NSTA 
IB = LOC (NBLOCK-U + I STA 
L(IB)=1 
DO 1120 1=1,3 

1120 REDN( I , I , I 8 ) =1 .0 . 

IDEGF= IDEGF+3 
WRITE! 6,6011) 

6011 FORMATCOTHE ORIGIN OF THE COORDINATE SYSTEM IS DEFINED BY INNER 
1ADJUSTMENT. * ) 

GO TO 10 

C 12 DEFINE THE ORIENTATION OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT , ’ 

1200 CONTINUE 

ASSIGN 1210 TO JRTN 
GO TO 960 
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1210 CONTINUE 

DO 1220 1STA=1,NSTA 
1B = L0C (NBLGCK-l )d ST A 
REDN(1 ,2,IB>= STAUVW(3»ISTA)/SPR 
REDN(1 ,3,iB)=-STAUVW(2,ISTA)/SPR 
REDN(2»l»Ib) =— S TAU VW ( 3»ISTA)/SPR 
REDNI2 ,3, I B I = STAU VW ( 1 , 1 ST A ) /SPR 
REDNI3 ,1,IB>= STAUVW (2»ISTA)/SPR 
RE0NI3 ,2, IB)=— STAUVWd, ISTA J/SPR 
UI8l = l 
1220 CONTINUE 

I0EGF= IDEGF+3 
WRITEI6, 60121 

6012 FORMAT ( 'OCR IENTATION OF THE COORDINATE SYSTEM DEFINED BY INNER 
1ADJUSTMENT PROCEDURE * ) 

GO TO 10 

C 13 DEFINE THE SCALE OF THE COORDINATE SYSTEM BY INNER ADJUSTMENT ECUATIONS 

1300 continue 

ASSIGN 1310 TO JRTN 
GO TO 960 
1310 CONTINUE 

DO 1320 ISTA=1»NSTA 
I B = LOC ( NBLOCK— 1 ) ♦ 1 ST A 
L ( I B ) = 1 
DO 1320 1=1,3 

REDNt 1,1, IB) =STAUVW( I , ISTA I / 1000000.0 
1320 CONTINUE 

C FILL IN EXTRA TWO ROWS IN BLOCK WITH DUMMY EQUATIONS 
NB=LOC (NBLOCK) 

REDN(2,2,NB)=1.0 
REDN(3,3»Nb)=1.0 
L ( N6 ) = 1 
lDEGF=IDEGF«-l 
WR 1 TE ( 6,6013 ) 

6013 FORMAT! 'OSCALE OF THE COORDINATE SYSTEM DEFINED BY INNER ADJUSTMENT 
IT PROCEEDURE.* ) 

GO TO 10 

C 19 COMPLETELY FIX ONE OR MORE COORDINATES OF A STATION 
1900 CONTINUE 

ASS 1GN 1910 TO JRTN 
GO TO 960 
1910 CONTINUE 

READ<3) IS, ISTA, XI, W 

00 1920 1=1,3 

1920 D 1 S ( 1 ) —X 1(1) — STAUVWI 1 »ISTA) 

1 6= LOC (NBLOCK— 1 ) + 1 STA 
NB=LOC(NBLOCK) 

DO 1930 1=1,3 , 

THE DIAGONAL ELEMENTS OF W ARE USED AS INDICATORS TO SHOW 
WHICH COORDINATES ARE TO BE FIXED. 

IF(W(I,I) .EQ.0.0) GO TO 1929 
REDN(1 ,1 ,1B)=1.0 • 

Ud, NBLOCK )=DISd) 

I DEGF= IDEGF-*- 1 
L ( IB ) = l 
GO TO 1930 

1929 REDN( I , I ,Nb ) =1 .0 
L(NB)=i 
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1430 CONTINUE 

WR I TE ( 6,6014 ) lS,(STANAM(i,lSTA),l=l,5>,Xl,(W( 1,1). 1=1,3) 

6014 F0RMATI////15X, ‘CARTESIAN COORDINATES OF STATI ON • , 15 , 2X . 5 A4, 3X , 
1‘FIXED AT*//15X,3F16.2//15X, ‘FIXED COORDINATES ARE INDICATED BY 
2N0N ZERO ENTRY BELOW • //15X , 3F16 .2 ) 

L(LOC( ISTA) )=1 
GO TO 10 
C 

1500 CONTINUE 

C 15 COMPLETELY FIX ONE OR MORE COORDINATES OF RELATIVE POSITION 
ASSIGN 1510 TO JRTN 
GO TO 960 
1510 CONTINUE 

READ (3) IS, ISTA, JS, JSTA,OXB,W 
I B= LQC ( N BLOCK— l ) ■*■ 1 ST A 
J8=L0C (NBLOCK— 1 ) ♦JSTA 
NB=LOC (NBLOCK) 

LI 1 B) = l 

L( JB)= 1 1 

L ( LOC ( I STA ) ) =1 
LILOCI JSTAI 1=1 
DO 1530 1=1,3 

IFIWI 1,1) .EQ.O.O) GO TO 1524 
REDNI I , 1 , IB) =1 .0 
REDNI 1,1 » JB)=— 1,0 

U I I ,NB LOCK )=OXB( I )— ( STAU VW (I, ISTA) — STAU VW ( 1 , JS TA ) ) 

IO£GF= IDEGF+1 
GO TO 1530 

1524 REDNI 1,1 ,NB ) =1 .0 
L l NB ) = 1 
1530 CONTINUE 

WRITE I 6, 6015) I S, I STANAM I I , I STA ) , I =1 , 5 ) , JS, I ST ANAM I I , JSTA ) , I =1 , 5 ) , 

1 DXB.IWI 1,1) ,1=1,3) 

6015 F0RMATI////15X, ‘RELATIVE POSITION BETWEEN STATION* ,I5,3X,5A4/ 

137X, 'AND STATION' , I5,3X,5A4/ 15X, 

2‘FIXED AT'/15X,3F16.2//15X, ‘RELATIVE COORDINATES WHICH ARE FIXED 
3ARE INDICATED BY A NON-ZERO ENTRY BELOW ' //15X, 3F16 . 2 ) 

GO TO 10 
1600 CONTINUE 

C SET UP A BLOCK OF 3 DUMMY EQUATIONS 
ASSIGN 1610 TO JRTN 
GO TO 960 
1610 CONTINUE 

NB=LOC INBLOCK) 

DO 1615 1=1,3 
1615 REONIl ,1,N8)=1.0 
L I NB ) = 1 
WRITE! 6,6016 ) 

6016 FORMAT! ‘OBLOCK OF 3 DUMMY EQUATIONS ADDED TO REDUCED NORMALS.') 

GO TO 10 

EXPAND REDUCED NORMALS BY ADDING A BLOCK OF THREE LAGRANGE MULTIPIERS 
960 CONTINUE 

NBL0CK=NBL0CK+1 

IF (NBLOCK. LE.MAXbLK) GO TO 961 
WR I TE I 6,6096 ) 

6096 FORMAT! ‘OATTEMPTED CONSTRAINT RESULTS IN AN ATTEMPT TO EXPAND THE 
1R EDUCED NORMAL EQUATION M ATR 1 X • /15 X , • BE YOND ITS DIMENSIONS.'/ 
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215X, ‘PROGRAM STOPS') 

STOP 

961 CONTINUE 

DO 965 ISTA=l,NBLOCK 
NB=LOC (NBLOCK— 1 ) ♦ I STA 
L(NB)=0 
00 965 1*1,3 
DO 965 J=l,3 

965 REDNU ,J,NB)=0.0 
DO 966 1*1,3 

966 U( I ,NBLOCK ) =0.0 

GO TO JRTN, (1110, 1210, 1310, 1410, 1510, 1610) 


1700 CONTINUE 
1800 CONTINUE 
1900 CONTINUE 
10 CONTINUE 
RETURN 
END 
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SUBROUTINE CONAP 
IMPLICIT REAL*8 (A-H.O-Z) 

C PROCESS A PRIORI CONSTRAINTS ON, AND BETWEEN, STATIONS 
COMMON ZNSTA/NSTA ,N BLOCK 
INTEGERA2 L*LSOLVE,IOS 
INTEGER ENDS IG/lhE/, CONTI N, ST ANAM 

COMMON ZNORMEQ/REDN (3,3,2485 ) , U< 3 , 70 ) , L ( 248 5 ) , L SOLVE 

COMMON /WPW/WPW ,XPU , IDEGF , IFSTA 

LOC (K )'= CK* (K + l ) ) !Z 

IFSTA=0 

NBLOCK=NSTA 

10 CONTINUE 

C WR I TE (6,6801 ) NSTA.N6L0CK 

6801 FORMAT (717) 

REAP (3) KODEtCONTIN 
1 F ( CONT IN . EQ .ENDS IG) GO TO 1000 
IF(KODE.LE.O) GO TO 950 
I F ( KODE .GT . 19 ) GO TO 950 
IF ( KODE.GT .9 ) GO TO 11 

GO TO (100, 200,300, 400, 500, 600, 700, 600, 900), KODE 

11 IF(KODE.LT.ll) GO TO 950 
K0DE2=K0DE— 10 

GO TO (1100,1200,1300,1400,1500,1600,1700,1600,1900) ,K0DE2 


100 

200 

300 

400 

500 


600 

700 

800 

900 


1100 

1200 

1300 

1400 

1500 

1600 


1700 

1800 

1900 


C 

950 

6095 


C 

CHECK 

1000 


CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

CALL. C0NAP1 ( KODE ) 

GO TO 10 
CONTINUE 
CONTINUE 
CONTINUE 
CONTINUE 
GO TO 950 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

CALL CON AP2 ( KCDE2 ) 

GO TO 10 
CONTINUE 
CONTINUE 
CONTINUE 
GO TO 950 

WR I TE ( 6,6095 ) KODE 

FORMATI’OILLEGAL CONSTRAINT CODE IN CONAP IGNORED*, 15) 
GO TO 10 

TO SEE IF NORMALS ARE SOLVABLE 

CONTINUE 

LSOLVE = 1 
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DO 1010 1SIA=1,NSTA 
N8 = LOC ( 1 ST A ) 

C WRI TE< 6 , 6801 ) NB , L (MB ) 

IF ( L( NB > . ME . O) GO TO 1010 
LSOLV6=0 
1 DEGF = 1 ST A 
1010 CONTINUE 
C 

RETURN 

END 
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SUBROUTINE SOLVE 

C SOLVE NORMAL EQUATIONS AND COMPUTE INVERSE FOR UP TO 40 STATIONS 
C BY THE METHOD OF TRIANGULAR MATRICES. 

C SEE DEPT. OF GEODETIC SCIENCE REPORT NO. 86, SECTION 5 
C THE SCHEME USED TO ADDRESS THE UPPER TRIANGULAR PART OF THE REDUCED 
C NORMALS IS THE SAME AS THAT USED IN FORMRN . 

C 

IMPLICIT REAL*8(A-H,0-Z) 

INTEGERS L , LSOLVE 

COMMON /NORMEQ/REDN 13,3,2485 ) ,U( 2,70) »L 124851 ,L SOLVE 
COMMON /WPW/WPW»XPU« I DEGF , NFS I A 
COMMON /NSTA/NST A 1,NB LOCK 

DIMENSION 0X13,70) ,TEMP(3,3,70) , 1 A 1 3 ,3 ) , T B ( 3 , 3 ) , TC (3 ) 

1NTEGER*2PC0DE ( 20 1 
COMMON/PCODES/PCODE 
INTEGERS P1V0TI2I0) 

DIMENSION RN(22365)*RU(210)»T£M(210)»DXI(210) 

EQUIVALENCE (RN ,R EON I , I RU ,U , DX I) , I TEM , TEMP I 
EQU IVALENCE (DX*U) 

c ■ : 

LOC (K)=(K*(K+l))/2 - 

C 

1F( PCODEI 16) .LT.2) GO TO 5 

DO 2 I STA=1 , NBLOCK 

00 1 J STA= I STA, NBLOCK -- 

NB= LOC (JSTA — 1I + ISTA 

WRITEIfa, 68031 ISTA , JSTA, NB , L ( NB ) 

6803 FORMAT (1H0»7I7! 

WRITE(6,6801 ) ( ( REDNI I ,J,NB),J=1,3), 1=1,3) 

6801 F0RMAT(//3(3D20.8/H 

1 CONTINUE 

WRITEI6,6802) ( U ( I , I STA I , 1 = l , 3 I 

6802 FORMAT (73020.8) .. . 

2 CONTINUE ’ 

5 CONTINUE “ 

CHECK TO SEE IF THIS SET OF EQUATIONS HAS BEEN MARKED SOLVABLE 

IF(LSOLVE.GE.l) GO TO 10 t ", 

9 HR I TE ( 6 ,600 1 ) I DEGF ‘ ’ 

6001 FORMAT ( 'OREDUCEO NORMALS MARKED UNSOLVABLE. PROGRAM STOPS.', 15) 

STOP 

10 CONTINUE 
REWIND 2 

NSTA1 GIVES THE NUMBER OF GRUUND STATIONS IN THE ADJUSTMENT 
NBLOCK GIVES THE TOTAL NUMBER OF BLOCKS OF UNKNOWNS IN THE REDUCED NORMALS 
INCLUDING BOTH STATION COORDINATES AND BLOCKS OF LAGRANGE MULTIPLIERS. 

THE EXPANDED (NBLOCK SQUARE) SET OF REDUCED NORMALS IS SOLVED 
NST A=NBLOCK 
REWIND 2 

DO 20 ISTA=1, NBLOCK 
DO 20 JSTA=ISTA, NBLOCK 
NB = LOC( JSTA — D + ISTA 

19 WR I TE ( 2 ) ( (REDN( I ,J,NB) , 1=1,3) , J=l,3) 

20 CONTINUE 
REWIND 2 
NUNK=3* NBLOCK 
NB=LOC (NUNK) 

DO 25 1=1, NB 
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25 RN(I)=O.C 

DO 30 ISTA=1,NBL0CK 

00 30 JSTA=ISTA,NBLQCK 
RE AD( 2 ) TA 

DO 30 1=1,3 

1 1 = 3*( ISTA— 1 ) + I 
00 30 J=1 ,3 
JJ=3*( JSTA-D+J 

1 F C 1I.GT.JJ) GO TO 30 

IB=L0C(JJ-1)+II 

RNC IB) =TAC 1 , J ) 

30 CONTINUE 

IF(PC0DE(l6) .IT. 3) GO TO 41 
00 40 1=1 , NUNK 
DO 35 J=I,NUNK 
NB = LOC ( J— 1 ) ■*• 1 
TEM(J)=RN(NB I 
35 CONTINUE 

40 WR I TE ( 6,6805 I 1 , ( TEMI J ) , J= I , NUNK1 
6805 FORMAT ( 15,6019.10/2501 5X,6D 19.10/1 ) 

41 CONTINUE 


PERFORM FIRST REDUCTION - COMPUTE R AND C MATRICES 

DO 100 1=1, NUNK 

FIND PIVOT ELEMENT 
IP = 0 

PMAX=0 .0 
DO 55 J=I,NUNK 
NB=LOC ( J ) 

IF ( DABS < RN (NB) ) . LE . PMAX ) GO TO 55 
PMAX=DABS(RN(NB) ) 

IP=J 

55 CONTINUE 
PIVOT! I )=IP 

IFIPC0DEU6I.GT.0) WR I TE ! 6 , 6806 ) I, IP, PMAX 
6806 FORMAT (2 17,020.10) 

I F(IP. EG. 0» GO TO 9 
C SWITCH ROWS AND COLUMNS 
CALL SWITCH! I, IP) 

C 

I B=LOC ( I ) 

RN! IB ) =1 . Q/RN (IB) 

IF! I. EG. NUNK) GO TO 100 
1P1=I+1 

C OUTER LOOP — REDUCE ROW K 
DO 80 K= I PI , NUNK 
K I B=LOC( K— 1 ) + I 
C GET MULTIPLIER 

TO=RN( KI6 J *RN( IB) 

IF! TD.EO.O.O)GO TO 80 
C REDUCE CONSTANT COLUMN 
RU(K)=RU(K J-TD4RU! I ) 

C INNER LOOP 

DO EO J=K , NUNK 


-E0.5 
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NB=LOC ( J— 1 )♦ I 
K JB=LOC ( J— 1 1 +K 
RNIKJ8 )=RN(KJB)-TD*RN(NB) 
80 CONTINUE 
100 CONTINUE 


XPU=0.0 

00 300 NM 1 P 1 =1 , NUNK 
l=NUNK-NMIPl-*-l 
NB=L0C ( I ) 

ACCUMULATE XPU 

XPU=XPU+RN(NB)*RU( I)**2 
1P1=I+1 


BACK SUBSTI TUATION 

IF( I .EQ.NUNK) GO TO 190 
DO 150 J= IP 1 »NUNK 
I B=L0C ( J-l )♦ I 
RUI I)=RU< II-RNI IB) *DX I ( J I 
150 CONTINUE 
190 CONTINUE 

DX 1 1 1 ) =RN ( NB ) *RU 1 1 ) 


DEVELOP ROW 1 OF INVERSE MATRIX 
I F( I .EQ .NUNK ) GO TO 300 
DO 280 NMJPI=1,NMIP1 
J=NUNK— NM JP1+1 
TD=0.0 

j-).,to=i.j3. : :• • •• -■ 

DO 270 K= IP1 »NUNK 
I B= LOC ( K— 1 ) ♦ I 
IF I J.EQ.I ) GO TO 245 
IF(K.GT.J) GO TO 240 
JB = LOCtJ-l)-»K 
TE=RN( JB ) 

GO TO 250 
240 CONTINUE 

JB=L0C(K-1)+J 
TE=RN( JB) 

GO TO 250 
245 CONTINUE 
TE=TEM I K ) 

250 CONTINUE 

TD=TD-RN(IB)*TE 
270 CONTINUE 

C STORE ITH ROW TEMPORARILY IN TEM 
TEM(J)=RN(N8)*T0 
280 CONTINUE 

C 

COPY ITH ROW OUT OF TEM 

00 290 NM JP 1 = 1 »NM I PI 
J=NUNK-NMJPl-*-l 
J8=L0C( J-D+I 
RN( JB) =TEM(j.) . ‘ . 

290 CONTINUE 
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C UNDO PIVOTING 
I P=PIVOT ( I ) 

CALL SWITCH! 1,1P» 

300 CONTINUE 
REWIND 2 
C 

DO 305 1=1 ,NUNK 
DO 30* J = I 1 NUNK 
I B=LOC ( J— 1 ) ♦ I 
30* TEM ( J) =RN( IB) 

WR I TE( 2 ) I TEM( J ) , J = I , NUNK ) 

IF(PC0DE(16) . LT . 3 ) GO TO 305 
WRITE (6, 6805) I , I TEM ( J ) , J = I , NUNK ) , OX I ( I) 
305 CONTINUE 


REWIND 2 

DO 310 1=1, NUNK 

RE ADI 2 ) ITEM! J) ,J = 1, NUNK) 

DO 310 J= I , NUNK 
ISTA=( I-D/3 + 1 
JSTA=( J-l )/3+l 
NB=LOCt JSTA-1)+ISTA 
I I=I-3*IISTA-1) 

JJ=J-3*I JSTA-1) 

REDNI I I»JJ»NB)=TEMIJ) 

I EC ISTA.EO.JSTA) REON I J J , 1 1 , NB ) =TEM! J) 

310 CONTINUE 
REWIND 2 

OUTPUT THE SOLUTION AND COVARIANCE BLOCKS CORRESPONDING TO THE STATION UNKNOWN 
DO 320 ISTA=1,NSTA1 
NB = LOC 1 1 STA ) 

DO 320 1=1,3 

TEMPI I ,1, ISTA)=REDN( I,I,NB) 

320 CONTINUE 

WRITE! 2) I IT EM PI I, I, I S T A ) ,1=1»3),ISTA=1,NSTA1) 

DO 350 ISTA=1,NSTA 
IF! ISTA.GT.NSTA1) GO TO 33V 
DO 330 JSTA=ISTA,NSTA1 
NB=LOC IJSTA— D + ISTA 
DO 330 1=1,3 
DO 330 J=1 ,3 

TEMPII ,J,JSTA)=REON< I ,J,NB) 

330 CONTINUE 

WRITE! 2) IDX! I, I STA) , I =1 , 3 ) , II I TEMP I I , J , JS TA ) , 1 = 1 , 3 ) , J=1 , 3 ) , 

1 JST A = ISTA,NSTA1 ) 

339 CONTINUE 

IFIPC0DEI16J.LT. 2) GO TO 350 
I B=LOC I I S TA ) 

WRITE! 6,6002) I ST A , I DXl I , I STA) , I = 1 , 3 ) , IIREDNI1 ,J,IB), 

1 J=1,3),I=1,3) 

6002 FORMAT I /// I5/3F16 • 8//3I 3D16.8/J ) 

DO 3*0 JSTA=ISTA,NSTA 

NB=LOC( JSTA-1) + I STA 

3*0 WR I TE I 6 ,6003 ) JST A , II REDN 1 1 , J , NB ) , J= 1 , 3 > , 1= 1 ,3 ) 

6003 F0RMATI//I5//3I3D16.8/)) 

350 CONTINUE 
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RETURN 

END 
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SUBROUTINE SWITCH! I, IP» 

C SWITCH ROW AND COLUMN I WITH ROW AND COLUMN IP 
IMPLICIT REAL*8U-H,0-Z) 

INTEGER*2 L,LSOLVE 

CQMM0N/N0RMEG/RE0N(3,3,2485),U<3,70) ,L(2485> ,LSOLVE 
COMMON /NSTA/NSTAl,NBLOCK 
DIMENSION RN!22365),RU(210) 

EQUIVALENCE (RN»REDN) »(RU*U) 

LOC(K)=(K*(K+i) )/2 
NSTA=NBLOCK 
NUNK=3*NBLOCK 
IFtlP.EQ.l) RETURN 
DO 25 J=1,NUNK 
NB=LOC ( J— 1 ) + I 
IF(J.EQ.I) GO TO 22 
I F ( J— I P ) 16,25,18 
16 IB=LGC ( IP-t ) + J 
GO TO 24 

18 IB=LOC ( J— 1)+IP 
GO TO 24 
22 IB=LOC ( IP ) 

GO TO 24 

24 CONTINUE 
TD=RN< IB) 

RN( IB) =RN(NB) 

RN(NB)=TD 

25 CONTINUE 
TD=RU( IP) 

RU ( IP ) =RU ( I ) 

R U ( I ) = TD 

RETURN 

END 
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DOUBLE PRECISION FUNCTION ANRADD ( I SGN* IDEG, M IN , SEC ) 
INTEGERS MINUS/1H -/, PLUS/1H+/ ,AMPSAN./1HE/, ISGN, JDEG,MJN 
DOUBLE PRECISION SEC 
I FI IDEG.GE.O) GO TO 10 
ISGN=MINUS 

IDEG=-IO£G ’■ * 

10 CONTINUE 

ANRADD = (DFLOAT( ( IDEG*60-»-M IN ) *60 ) ♦SEC 1/206264 .8 0625 

IF( ISGN. £Q. MINUS )ANRADD=-ANRADD 

IFI 1SGN.EQ . AMPSAN ) ISGN=PLUS 

RETURN 

END 
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INTEGER FUNCTION KSTAID(ID) 

COMMON/ST AORD/KORDER( 150) 

COHMON/NSTA/NSTA 

kstaid=o 

C SEARCH TABLE OF STATION IDENTIFIERS FOR THE INTERNAL NUMBER OF THIS STATION 
DO 10 1=1 t NSTA 
IFIKORDERC I) .NE.ID) GO TO 10 

kstaid=i 

RETURN 
10 CONTINUE 
f RETURN 
END 


- 172 - 



s 


SUBR0UTINEUVWTG3CUVW, DATUM, PHI fLAM, Hi 
C CONVERT RECTANGULAR TO GEODETIC COORDINATES 
C ALIAS FOR UVWTG 

IMPLICIT REAL*8(A-Z) 

DIMENSION UVW<3) ,DATUM(2I 
LAM=DATAN2 (UVWI 2 1 , UVW (II) 

IF ( LAM.LT .0.0) LAM=LAM*6. 283 18530717958 
OME2M DATUM 1 2 1 /DATUM (111 **2 
E2=1.0— 0ME2 

P=DSQRT(UVW<1)**2+UVW(2)**2) 

MP=UVW(3)/P 
TP1=NP/0ME2 
PHI 1=0ATAN( TP1 > 

5 TTP=TP1*TPI 

SEC P=DSQRT ( l .O+TTP I 

N=DATUM(1 )*SECP/DSQRT( 1.0+0ME2*TTP) 
H=P*SECP— N 

TP2=HP / ( 1 .0— E2*N/ ( N+H ) ) 

PHI =DATAN( TP2) 

I FI DABS ( PH I —PH III. LT • 1 »D— 12 I RETURN 

PHI 1=PHI 

TP1=TP2 

GO TO 5 

END 
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SUBROUTINE UVWTG2IUVW, DATUM, PHI ,LAM,H> 

C CONVERT RECTANGULAR TO GEODETIC COORDINATES 
C ALIAS FOR UVWTG 

IMPLICIT REAL*8 ( A— Z) 

DIMENSION UVW<3) ,DATUM<2) 

LAM=DATAN2 ( UVW( 2 ) ,UVW ( 1 ) ) 

1FILAH.LT. O.O) LAM=LAM+6. 283 18530717958 
0ME2= ( DATUM ( 2 ) /DATUM ( 1 )) **2 
E2=1.0— 0ME2 

P=DSQRT(UVW ( 1 ) **2+UVW( 2) **2 ) 

HP=UVW(3)/P 
TP1=WP/0ME2 
PHI 1=DATAN( TP1 ) 

5 TTP=TPI*TP1 

SECP=DSQRT< 1.0+TTP) 

N=DATUM(1)*SECP/DSORT(1.0+OME2*TTPI 

H=P*SECP-N 

TP2=HP / ( I .0— E2*N/ ( N*H ) ) 

PHI=DATAN(TP2) 

I F ( DABS ( PH I— PH ID.LT.l.D-12) RETURN 

PHI i=PHI 

TP1=TP2 

GO TO 5 

END 
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SUBROUTINE DELL ( DX ,DXCOV, PH I , L AM,H, DATUM ,DP ,D L, DH .DELCOV , RLX) 
IMPLICIT REAL*8(A-H,0-Z> 

DIMENSION OX(3» f OXCOV(3,3 1 ,0 ATUMI21 , DE LCOVC 3 ,3 ) ,0E(3 ) ,GE ( 3 , 3 ) 
DIMENSION RLX(3,3J 
REAL*8 LAM 

ESQ=1 • 0— (DATUM (2) /DATUM! I I )**2 
CP=DCOS(PHl* 

SP=OSIN( PHI I 
SL=DSI N( LAM ) 

CL=DCOS(LAM! 

EW=DSQRT( I .0— ESQ*SP**2 ) 

EN= DATUM! 1 ) /EW 
EM=EN* ( 1.0-ESQ )/FW**2 
H1=EM+H 
H2= ( EN+H ) *C P 
GE ( 1 > 1 ) =— SP*CL/H1 
GE( 1»2)=— SP*SL/H1 
GE ( I,3»=CP/H1 
GE ( 2 , 1 ) =— SL/H2 
GE(2»2)=CL/H2 
GE ( 2 1 3 ) =0.0 
GE ( 3« 1 ) =CP*CL 
GE( 3»2 I =CP*SL 
GE ( 3»3 ) =SP 
C 

CALL DGMPRDCGE.DX.DE, 3,3,1! 

DP=DE( 1) 

DL=DE( 2) 

DH=DE( 3) 

C 

DO 14 1=1,3 
DO 14 J=l,3 
SUM=0.0 
00 12 K=1 , 3 
00 12 L=l,3 

12 SUM=SUM*GE( I ,K ) *DXCOV( K,L)*GE(J,L) 

14 DELCOV ( I , J ) =SUM 
C 

DO 15 J=l,3 

RLX ( 1 * J) =GE ( 1 , J) *H1 

RLX C2, J ) =GE( 2, J )*H2 

15 RLXI3, J)=GEI3,J) 

C 

RETURN 

END 
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SUBROUTINE D ANG ( ANGR » 1 SGN . I OEG ,MIN ,SEC ) 
IMPLICIT REAL*8 ( A— H»0»Z ) 

INTEGER 8LANK/1H / ,M I WS/ 1H-/ 

I SGN=8LANK 

IF! ANGR.LT.O.OI 1SGN=MINUS 
ANGD=5 7. 29577951 3082D0*DABStANGR) 

ID£G=I DINT ( ANGD ) 

FMIN=ANGD-DFLOAT{ IDEG) 

FMI N=FHIN*60 .0 
MIN=IDINT ( FM IN > 

SEC=(FMIN-DFLOAT(MIN) »*60.0 

RETURN 

END 


- 176 - 



SUBROUTINE UVWTGIUVW, DATUM, PHI , LAM, H > 

C CONVERT RECTANGULAR TO GEODETIC COORDINATES 
IMPLICIT REAL*8< A— Z) 

DIMENSION UVWI 3) ,DATUMI2) 
LAM=OATAN2(UVW(2) ,UVH(il) 

IFILAM.LT. O.O) LAM=L AM ♦6. 283 18 5 30 71 795 8 
0ME2= I DATUM! 2 ) /DATUM ID) **2 
E2=1.0— 0ME2 

P=DSQRT(UVWI 1)**2*UVW(2>**2> 

WP=UVWI3)/P 
TP1=WP/0ME2 
PHI 1=DATAN ( TP1 ) 

5 TTP=TP1*TP1 

SECP=DSQRT( 1.0+TTP) 

N=0 ATUM ( 1 ) *SECP/D SORT! 1.0+OME2* TTP ) 
H=P*SECP-N 

TP2=WP/( 1 .0— E2*N/ ( N+H) ) 

PHI =DATAN ( TP2 ) 

I F C DAB SI PH I -PH II ) . LT. l.D-12 ) RETURN 

PHI 1=PHI 

TP1=TP2 

GO TO 5 

END 


t 
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FUNCTION KSIU2US) 

KSID2=KSTAlOUS) 

IF( KSID2.GT.0) RETURN 
WR I T6 ( 6*6000 ) IS 

6000 F0RMATI//10X, ’STATION NUMBER NOT FOUND IN INPUT LIST’, 15) 
STOP 
END 
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SUBROUTINE SATXYZ (XS,YS,ZS) 

IMPLICIT REAL*8(A-H,0-Z) 

INTEGER STANAM,IDS*2 

COMMON /ST ALOC /ST AUVW (3»150)»DATPRMt2»15) , DATNAMt 4, 15 > , 
1STANAMI5,150) ,IDS( 150) 

COMMON/ST APLH/STAPLH 1 2, 150) 

COMMON /RANGED/RAN ( 50) ,VARRA(50) ,RMSMC , NS TE, KSTATE ( 50 ) , I TES T,N ITR 
DIMENSION At 3 ) , AN t 3 ,3) ,C l 3 > , L l 3) , M( 3 ) , AXt 3 ) 

C GET THE FIRST APPROXIMATION TO THE SATELLITE POSITION 
PI=3. 14159265356 
TP I =2. *P1 
PH I =0.0 
ALAM=0.0 
l S=NSTE 
DO 20 1=1, IS 

PHI =PH l+STAPLH ( 1 , KSTATE ( I ) ) 

STALNG=STAPLH( 2,KSTATE( I) ) 

IFt I.EQ.l) GO TO 19 

I F ( STALNG— STAPLH (2 ,KSTATE ( 1 ) ) ,GT. P I ) STALNG=STA LNG-TP I 
IF(STAPLH(2»KSTATE(1))— STALNG.GT.PI) STALNG=STALNG+TPI 

19 ALAM=ALAM ♦ STALNG 

20 CONTINUE 
PHI =PH 1/ IS 
ALAM=ALAM/IS 
H=1.6D06 

IDTS=IDS(KSTATE(1) ) 

CALL UVWD(DATPRM(1,IDTSJ , DATPRM 1 2 , IDTS ) ,PH I , AL AM ,H ,XS , YS , ZS) 

C 

NITR=0 
25 CONTINUE 

C START ANOTHER ITERATION 
NITR=NITR+1 
WPW=0.0 
DO 30 1=1,3 
C( I )=0.0 
DO 30 J=l,3 
30 AN( I , J ) =0 .0 
C 

DO 50 IS=1 ,NSTE 
DX=XS-STAUVW(1,KSTATE(IS) ) 

OY=YS— STAUVW(2,KSTATE( IS) ) 

DZ=ZS— ST AUVW (3,KSTATE(IS) ) 

R=DSQRT(DX*DX+DY*DY-»DZ*DZ ) 

AL=RAN( IS) — R 

WPW=AL*AL/VARRA ( IS)**2+WPW 
A ( 1 )=DX/R 
A ( 2 ) =DY/R 
A (3 )=DZ/R 
DO 40 1=1,3 

C( I )=CCI)+A( I )*AL/VARRA(IS)**2 
DO 40 J=1 » 3 

40 AN(I,J)=ANI 1 ,J)+At I ) *A( J ) /VARRA ( IS ) **2 
50 CONTINUE 

CALL DMINV(AN,3,DET,L,M) 

CALL DGMPRDt AN, C, AX, 3, 3,1 ) 

RMSMC=WPW/( NSTE-3 ) 

C TEST FOR CONVERGENCE 
I C0NVR=1 
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00 55 1=1,3 

IF(DABS(AX( I) l.GT.0.01) IC0NVR=0 
55 CONTINUE 

UPDATE 

XS=XS+AX(1) 

YS=YS+AX<2) 

ZS=ZS+AX ( 3 ) 

I F ( 1CQNVR . EQ . 1 ) RETURN 
I F ( NITR.LT.20 ) GO TO 25 
C SET ITEST =2 INDICATED THAT CONVERGENCE HAS NOT OBTAINED IN 20 ITERATIONS 
I TEST=2 
RETURN 
END 
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SUBROUTINE RNG360 ; *■ » ' ■ 

IMPLICIT REAL*8 ( A— H »Q— Z ) 

C S/360 VERSION OF SAR PROGRAM FOR SATELLITE DISTANCES 
INT EGER*2 PC0DEI20) 

COMMON /PCODES/PCOOt 

INTEGER*^ ENDSIG/IHE/,CONTIN,OELCOD(2>/IH ,1H*/,EC0DE 
INT EGER*2 I D ( 50 ) , 1 YR I 50 ) , IDAY ( 50 ) , I HR t 50 ) ,M I N( 50) 

DIMENSION SEC (50) , RAN (50) ,VARRA(50) , MONTH ( 50 ) , KSTATE ( 50 > 
DIMENSION DN!3»3»i5’0),BN!3,3»50)»DDN!3»3),DK!3»156),DDK!3)»AI3) 
COMMON/NSTA/NSTA • 

DIMENSION NOBSTA! 150) ,VPVSTA! 150) 

COMMON /RANGE D/RAN, VARR A, RMSMC, NSTE, KSTATE, I TEST.NITR 
DIMENSION POSSAT ( 3 ) * DX ( 3 J 
DIMENSION L1(3),L2<3) 

INTEGER STANAM, IDS*2 

COMMON /STALOC /S T AUVW (3,150) , DA TPRM (2 , 1 5 ) , DATNAIM 4, 15 ) , " 

1STAN AM (5,150), IDS( 150) 

COMMON /STAORD/KORDERI 150) 

COMMON /HPH/HPH , XPU , 1DEGF,NFSTA 
COMMON /STAPLH/STAPLH! 2, 150) 

DATA RPD/57. 295779513/ 

C 

REWIND 2 
REW INO 3 

READ (3) TD.STAPLH 
WR I TE ( 6,6009 ) TD 

6004 FORMAT I//20X, 'TEST VARIANCE ='F20.2> 


WRITE! 6,6001) ~ 

6001 FOR MAT (///'0 STATION* ,T12, 'DATE* , T24, *TI ME *, T43 ,* RANGE ', T60 , 
1 'UNCERTAINTY', T76, *MISCLOSURE • ) 


DO 70 KSTA=1,NSTA • r 

N0BSTA(KSTA)=0 
VPVSTA(KSTA)=0.0 
DO 70 1=1,3 
OK ( I ,KSTA ) =0.0 
DO 70 J=1 ,3 
DN( I , J , KSTA ) =0.0 
70 CONTINUE 
C 

KEVENT=0 
EPR =0. 0 
210 CONTINUE 

READ (3) 1EVENT,NSTE,EPR, ( ID( 1 S ) , I YR C IS ) .MONTH! IS ) , IDAY< I S) , 

X I HR ( I S ) , 

1MIN(IS) ,SEC( IS) ,RAN< IS ) , V ARRA ( I S) ,KSTA TE( IS » , I S= 1 , NS TE ) .CONTIN 
WR I TE( 6,6008 ) IEVENT 
6008 FORMAT!/ IX, • EVENT ', 16) 

I TE ST=0 

1 F ( NSTE .G T . 3 ) GO TO 220 

C SET ITEST =1 TO INDICATE THAT LESS THAN FOUR STATIONS WERE OBSERVING 
1 TE ST= 1 

DO 280 I S=1 ,NS)E 

280 WRITEI6, 6009) I D ( I S ) , 1 YR ( I S) .MONTH! I S) , I DAY! IS ) , IHR ( I S) , 

1M IN (.1 S ) , SEC I IS), RAN (,1 S') » : V ARR A { l‘S) 
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6009 FORMAT C I7,2X, 1 2 , IX ,A3 , IX , 12 , 2X ,2 1 3 ,F8 .4, FI 8. 3, FI 5 . 2 , F15 .2 ) 
GO TO 630 
220 CONTINUE 

CALL SATXYZ(XS,YS,ZS) 
lF(RMSMC.GT.TD) ITEST=3 
IF(ITEST) 311,300,311 


SET UP OBSERVATION EQUATIONS FOR THIS EVENT AND COMPUTE 
CONTRIBUTIONS TO THE NORMAL EQUATIONS 
300 CONTINUE 

K EV ENT =KE VENT +1 
DO 310 1=1,3 
DDK ( I ) =0 .0 
DO 310 J=1 ,3 
DDN ( I , J) =0.0 

310 CONTINUE 
C 

311 CONTINUE 
POSSAT ( 1 ) =XS 
P0SSATI2) =YS 
POSSAT (3 ) =ZS 

DO 390 I S=1 , NSTE 
KSTA=KSTATE( IS) 

DO 305 1=1,3 

305 DXII) = POSSAT! 1 )— ST AUVW( 1 , KSTA ) 

RC=DSQRT( DP DOT ( DX, DX ,3 ) ) 

AL=RAN( ISI-RC 

WRITE! 6,60091 ID< I S ) , I YR ( I S ) , MONTH! 1 S » , IDAY ( 1S),1HR!1S), 

1MIN ! IS I , SEC (IS) .RAN! IS ) ,VARRA( I S) , AL 
IF(ITEST) 390,307,390 
307 CONTINUE 
COMPUTE WEIGHT 

WT=1./VARRA( IS) **2 
DO 306 1=1,3 

306 A! I )=DX( I )/RC 
C 

COMPUTE VPV OF MISCLOSURES 
VPVTO=AL*WT*AL 

VPVSTA (KSTA) =VPVSTA( KSTA )*VPVTO 
NOBSTA(KSTA)=NOBSTA(KSTA)-H 
COMPUTE CONTRIBUTIONS TO NORMAL EQUATIONS 
DO 330 1=1,3 
TERM=A( I )*WT*AL 
DK( I, KSTA I =DK( I, KSTA) -TERM 
DDK ( I) =DDK( I )+TERM 
DO 330 J=1 ,3 
TERM=A(1)*WT*A(J) 

BN! I , J , IS) =— TERM 
DN( 1,J,KSTA)=DN! I , J.KSTA ) +TERM 
DDN! I,J)=DDN( I,J)+TERM 
330 CONTINUE 

390 CONTINUE 
C 

IF ( ITEST ) 600,391,600 

391 CONTINUE 

CALL DMINV ( DON, 3 ,D£T,Ll,L2) 

WRITE! 2) NSTE, DDN, DDK, ( ( < BN! I ,J , I S ) , 1=1,3 ) , J =1 , 3 ) , KST ATE ( 1 S) , 
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1IS=1»NSTE) t CONTIN 
600 CONTINUE 

WRITE! 6 t 6011 )RMSMC,NITR 

6011 FORMAT (• VARIANCE OF EVENT ADJUSTMENT = ',F10.2, 


1* AFTER*, 13,* ITERATIONS') 

IF! PCODE (ID) 610,630,610 

610 IF! PCODE (11) —3 ) 611,612,611 

611 WR 1 TE ( 6,6022 ) POSSAT 

6022 FORMAT!* SATELLITE POS IT ION * , 3F1 5 . 3 ) 

IF! PCODE (11 ) —2 ) 612*630,612 

612 I DTS=I OS (KSTATE! 1 ) ) 

CALL UVWTG2(P0SSAT,DATPRM{1, IDT S) , PHI, FLAM, H) 

PHI =PH I+RPD 

F LAM=F LAM*RPD • ' 'IS- ■ ' 

WRITE(6, 6023) PHI, FLAM, H “ • • ’ 

6023 FORMAT!:* GEOD . COORD. OF SATELLITE •-,2F1A.6,F14.1) 

630 CONTINUE 

IF(ITEST) 290.6AO , 290 
290 WR I TE ( 6 , 6015 ) ITEST 

6015 FORMAT (IH ,27X, 'ENTIRE EVENT DELETED. DELETION CODE = *,I3) 


C I TEST=0 MEANS A GOOD EVENT 
C ITEST=1 MEANS NOT ENOUGH OBSERVATIONS 

C 1 TEST=2 MEANS MORE THAN 20 ITERATIONS WERE REQUIRED TO GET APPROXIMATE 
C SATELLITE POSITION 

C I TEST=3 MEANS THE EVENT IS REJECTED BECAUSE THE EVENT VARIANCE IS GREATER 
C THAN THE TEST VARIANCE 

6 AO CONTINUE 
C 

I F ( CONTIN. EQ.ENDS I G) GO TO 700 
GO TO 210 


700 CONTINUE 

IECK TO SEE IF END SIGNAL HAS BEEN WRITEEN ON DATA SET FT02 
IF! ITEST. EQ.O) GO TO 710 
BACKSPACE 2 

READ AND WRITE LAST RECORD FROM LSST GOOD EVENT 

READ (2) NSTE , DON, DDK, ( ( ! BN! I , J , I S ) , 1 = 1 ,3 ) , J=1 ,3 ) , KSTATE 1 1 S ) , 

1 I S= 1 ,NSTE ) 

WR 1 TE! 2 ) NSTE, DON, DDK, ( ( ( BNI I , J , I S) , 1=1 ,3) , J=1 , 3 ) , KSTATE (I S ) , 

1 I S= 1 ,NSTE ) .CONTIN 
710 CONTINUE 

WR I TE ( 2) ((( DNI I , J , KST A ) , 1 = 1,3) , DMJ.KSTA) » J=1 » 3 ) , 

XKSTA=1 ,NSTA ) 

WR I TE( 6,6018 ) (KORDER (KSTA ) , ( (ON 1 1 , J,KSTA) , J=1 , 3 ) , I =1 , 3 > , 
1KSTA=1,NST«) 

6018 FORMAT ( (15/3(3018.7/) ) ) 

WPW=0.0 

NOB S=0 

WRI TE ( 6,6019) 

6019 F0RMAT(1H1,8(/),10X, 'ANALYSIS OF MISCLOSURES BY STATION'// 

IT10, 'STATION', T20, 'NUMBER OF OBSER VA TIONS ' , T50 , ' RMS MISCLCSURE') 

DC 750 KSTA=1,NSTA 
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NOBS=NQBS+NOBSTA (KSTA I 
WPW=WPW-*-VPVSTA ( KSTA) 

RMSMC=0.0 

IF (NOBSTA(KSTA) .GT.O) RMSMC=DSQRT( VPVS TA ( KSTA) /DFLOAT (NQBSTA(KSTA) 
1) ) 

WR I TE( 6 1 6020 ) KORDER (KSTA ) »NOBS TA ( KSTA ) ,RMSMC 

6020 FORMAT(Tl0,I7,T35tI7,T50,F14.2) 

750 CONTINUE 

IDEGF=N0BS-3*KEVENT 

RMSMC=DSQRT ( WPW /DFLOAT ( I0E6F ) l 

WRITE (6,6021 ) NOBStKEVENT# IDEGF.WPW, RMSMC 

6021 FORMAT(////10X, 'TOTAL NUMBER OF GOOD OBSERVA TI ONS • , T60 » 1 8// 

110X.* TOTAL NUMBER OF GOOD EVENTS ‘,T60 , 18 « // 


210X t ‘CORRESPONDING DEGREES OF F REE DOM • , T60 , 18// 

310X, 'TOTAL SUM OF SQUARES OF MI SCLOSUR ES • ,T60t FI 1 . 2// 

410X, ‘CORRESPONDING STANDARD DEVIATION OF UNIT WE IGHT • ,T60 , FI 1 .2 ) 
RETURN 
END 
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SUBROUTINE RRDATA 
IMPLICIT REAL*8(A-H,0-Z) 

INTEGER*4 ENDS 1G/1 HE/ .CON TIN 

INTEGERS ID ( 50) , I YR ( 50 ) , IDAY! 5 0) , IHR ( 50 ) .MINI 50 ) 
DIMENSION SEC I 50) .RANI 50) .VARRA 1 50 ) , MONTH 1 50 ) . KST ATE I 50 ) 
COMMON/ST APLH/STAPLH I 2. 150) 

COMMON /GBSD/OBSD! 150 ) .OVOBSD 
INTEGER*2 PCO0EI20) 

COMMON /PCODES/PCODE 

MAXSTE=50 

S PR =2 0626 A. 80625 

PI =3. 1415926 5358 

PI2=2.0*PI 

WPWSP=0.0 

READI5 .5004) TD, OVOBSD 

HR I TE 1 6.6004 ) TD • ‘ > 

5004 F0RMAT(F20.2,F10.2) 

6004 FORMAT I//20X,# TEST VARIANCE =»JF20.2)'= 


C 

C START DATA INPUT 
REWIND 3 

WRITE! 3) TD.STAPLH 

IS-0 

IEVENT=0 

EPR=0.0 

C ENTER HERE FOR A NEW OBSERVATION 
C 

200 IS=IS*1 
205 CONTINUE 

READ(5,1022,END=901) ID! IS) ,IYRI IS) ,MON THI I S ) , I DAY I I S ) , I HR I I S ) . 
lMIN(IS), SEC! ISI.SECl. RANI I S ) ,RA 1 , VARRA I I S ) .CONTIN 
R AN ( I S ) =RAN! IS) ♦RA 1/1000. 

1022 FORMAT 1 14X, 14, 51 2, F2 .0 , F4.0, F16 .0 , F3 .0 , 1 IX , F6. 3.9X , A 1 ) 

IFISEC1.LT. 1.) GO TO 201 
SEC! IS)=SECI IS)+SEC1/10000. 

GO TO 202 

201 SECIISIrSECI ISI+SEC1 • • • 

202 CONTINUE 

IFICONTIN.EQ .ENDS IG) GO TO 250 
DDT=DFLOAT IMJDI IDAYI IS) .MONTH! I S ) , I YR ( IS ) ) ) 

DDT=DDT+(D FLOAT! ! I HR ( IS)*60+MIN( IS))*60)+SECIIS») /864.0D2 
IF! IS.LE.l) GO TO 210 

C THIS TEST SHOULD BE TRUE ONLY FOR THE FIRST CARD OF THE FIRST EVENT. 
C • 

CHECK FOR END OF EVENT, ALLOWING 0.5 MS DISCREPANCY 
IF!DABS(00T-EPR» .GT.0.58D-8) GO TO 250 
C 

C ENTER HERE TO BEGIN A NEW EVENT 

C THE FIRST ENTRY OF THE EVENT SHOULD ALWAYS BE MADE WITH IS=1 

210 CONTINUE 
IDD=ID! IS) 

KSTA=KSTA1D< IDO) 

I F( KSTA.GT.O ) GO TO 220 

WRITE! 6,6042) I D I I S ) , IHR < I S) ,MI N! 1 S ) ,S FC ! I S) , I DAY ! 1 S ) .MONTH! IS) , 

1 1 YR (IS* 

6042 FORMAT ( 5X» 'STATION NUMBER NOT FOUND IN INPUT LI ST' , 1 5 , 3X, 2 1 3 , 
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1F8.4.3X, I3.A3, 12, 'OBSERVATION IGNORED* » 

GO TO 205 
220 CONTINUE 

I F ( PCODE ( 12 ) . EQ . 1 ) VARRA ( I-S) =0B SOI KSTA ) 

I F( PCODE (12) . EQ.2 ) VARRA I IS)=0V0BSD 
KSTATECIS)=KSTA 
EPR=DDT 
GO TO 200 

END OF INPUT FOR THIS EVENT. BEGIN PROCESSING 
250 CONTINUE 
NSTE=IS-I 
IEVENT=1EVENT«-1 

IFl IHRINSTE+I) .EQ.99) CONT 1 N=ENDS1 G 

WRITE (3) IEVENT.NSTE »EPR« ( I D< I S » , I YR ( IS ) , MONTH! I S ) , I DAY (1 S ) , 

X I HR ( I S ) « 

IMIN(IS) ,SEC( IS). RANI I S ) , V ARR A 1 1 S ) , KSTA TE I IS) » I S=1 . NSTE ) » CONT IN 
TEST FOR END OF INPUT 

IF! CONTIN »E0 . ENDS IG ) GO TO 700 
PREPARE FOR NEXT EVENT 
I DC l ) = ID INSTEAD 
1YR!1)=IYR!NSTE+1) 

MONTH! 1)=M0NTH!NSTE*1) 

IDAY(1)=I DAY INSTE+l ) 

IHRI1)=IHR!NSTE*1) 

M IN ( 1 ) =MI N! NSTE+ 1 ) 

SEC 1 1 ) =SEC I NSTE+-I ) 

RAN!1)=RAN!NSTE+1) 

VARRA ( 1)=VARRA I NSTE+1 ) 

RETURN TO START A NEW EVENT 
IS = 1 

GO TO 210 

700 RETURN 

ERROR EXITS 
901 CONTINUE 

C ENTER HERE IF END SIGNAL CARD IS MISSING FROM INPUT DATA DECK 
CONTIN=ENOSIG 
GO TO 250 
END 
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